在Shinyapps上运行应用程序时出现问题(错贴了传单地图)

时间:2019-01-31 15:27:17

标签: r shiny

我的闪亮应用程序似乎有一个非常奇怪的问题,一定会得到一些帮助。该应用程序当前位于Shinyapps.io上。您可以在这里看到它:https://esbriskin.shinyapps.io/Media_Freedoms/ 2

我对可视化与世界各地新闻自由有关的趋势感兴趣。我使用Shiny和Leaflet创建了一个交互式地图,其中基于新闻自由度对国家进行了阴影处理(较暗,红色阴影=较高的新闻自由度,表示总体上新闻自由度较低)。当您将鼠标悬停在每个国家/地区上时,名称和分数将显示为标签。您可以通过调整底部的橙色旋钮按年份调整分数。

奇怪的是,当我在计算机上本地运行该应用程序时,它运行良好,但是当我将其上传到服务器时,某些国家/地区的标签错误且颜色不正确。这是它的外观(在本地运行时):

App run locally

但是,例如,当它在shinyapps服务器上时,“加拿大”被标记为“喀麦隆”,其颜色为“中国”,而“中国”则被标记为“智利”,而其他一些国家则被错误地标记。我已经尝试了对多个方面进行故障排除-我尝试使用世界shapefile而不是'rworldmap'函数,并且我通过ISO3代码(而不是国家/地区名称)加入了国家/地区数据,以避免潜在的混淆,所有这些都具有相同的结果:在本地工作得很好但是一旦将其放置在Shinyapps服务器上,就会对这些国家/地区贴错标签。

代码在下面。我也将其发布在R-Studio Cloud上,您可以通过以下链接访问它:https://rstudio.cloud/project/194425

The data used is available for download here:

# Load Libraries  

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinythemes)
library(DT)
library(dplyr)
library(tidyr)
library(maptools)
library(rgdal)
library(rworldmap)
library(leaflet)
library(sp)
library(ggplot2)
library(plotly)
library(lubridate)
library(rAmCharts)
library(rsconnect)

pf <- read.csv("Index_Data_2000.csv", header = TRUE)

# Cleaning the data 

pfg <- pf[ -c(2:11) ]

pfg <- gather(pfg, measure, score, A.Legal:Status.16, factor_key = TRUE)

colnames(pfg)[1] = "country"

pfg$score <- as.numeric(pfg$score)

pfg <- pfg %>% arrange(country)

# Creating a 'year' Column

year <- data.frame(rep(seq(2001,2016, by = 1), 5))

colnames(year) <- "year"

year <- year %>% arrange(year)

y <- rep(as.vector(year), each = 197)

y <- data.frame(unlist(y, recursive = TRUE, use.names = TRUE))

pfg <- cbind(pfg, y)

colnames(pfg)[4] = "year"

# Cleaning the 'measure' Column

measurenames <- c("Legal", "Political", "Economic", "Total_Score", "Status")

measurenames <- data.frame(rep(measurenames, 3152))

pfg <- cbind(pfg, measurenames)

pfg$measure <- NULL

colnames(pfg)[4] = "measure"

# Adding ISO3 codes to country data to use as join key


ISO3 <- c("AFG",
          "ALB",
          "DZA",
          "AGO",
          "ATG",
          "ARG",
          "ARM",
          "AUS",
          "AUT",
          "AZE",
          "BHS",
          "BHR",
          "BGD",
          "BRB",
          "BlR",
          "BEL",
          "BLZ",
          "BEN",
          "BTN",
          "BOL",
          "BIH",
          "BWA",
          "BRA",
          "BRN",
          "BGR",
          "BFA",
          "BDI",
          "KHM",
          "CMR",
          "CAN",
          "CPV",
          "CAF",
          "TCD",
          "CHL",
          "CHN",
          "COL",
          "COM",
          "COG",
          "COD",
          "CRI",
          "CIV",
          "HRV",
          "CUB",
          "CYP",
          "CZE",
          "DNK",
          "DJI",
          "DMA",
          "DOM",
          "ECU",
          "EGY",
          "SLV",
          "GNQ",
          "ERI",
          "EST",
          "ETH",
          "FJI",
          "FIN",
          "FRA",
          "GAB",
          "GEO",
          "DEU",
          "GHA",
          "GRC",
          "GRD",
          "GTM",
          "GIN",
          "GNB",
          "GUY",
          "HTI",
          "HND",
          "HKG",
          "HUN",
          "ISL",
          "IND",
          "IDN",
          "IRN",
          "IRQ",
          "IRL",
          "ISR",
          "PSE",
          "ITA",
          "JAM",
          "JPN",
          "JOR",
          "KAZ",
          "KEN",
          "KIR",
          "KOS",
          "KWT",
          "KGZ",
          "LAO",
          "LVA",
          "LBN",
          "LSO",
          "LBR",
          "LBY",
          "LIE",
          "LTU",
          "LUX",
          "MKD",
          "MDG",
          "MWI",
          "MYS",
          "MDV",
          "MLI",
          "MLT",
          "MHL",
          "MRT",
          "MUS",
          "MEX",
          "FSM",
          "MDA",
          "MCO",
          "MNG",
          "MNE",
          "MAR",
          "MOZ",
          "MMR",
          "NAM",
          "NRU",
          "NPL",
          "NLD",
          "NZL",
          "NIC",
          "NER",
          "NGA",
          "PRK",
          "NOR",
          "OMN",
          "PAK",
          "PLW",
          "PAN",
          "PNG",
          "PRY",
          "PER",
          "PHL",
          "POL",
          "PRT",
          "QAT",
          "ROU",
          "RUS",
          "RWA",
          "KNA",
          "LCA",
          "VCT",
          "WSM",
          "SMR",
          "STP",
          "SAU",
          "SEN",
          "SRB",
          "SYC",
          "SLE",
          "SGP",
          "SVK",
          "SVN",
          "SLB",
          "SOM",
          "ZAF",
          "KOR",
          "SON",
          "ESP",
          "LKA",
          "SON",
          "SUR",
          "SWZ",
          "SWE",
          "CHE",
          "SYR",
          "TWN",
          "TJK",
          "TZA",
          "THA",
          "GMB",
          "TLS",
          "TGO",
          "TON",
          "TTO",
          "TUN",
          "TUR",
          "TKM",
          "TUV",
          "UGA",
          "UKR",
          "ARE",
          "GBR",
          "USA",
          "URY",
          "UZB",
          "VUT",
          "VEN",
          "VNM",
          "PSE",
          "YEM",
          "ZMB",
          "ZWE") 

i <- rep(ISO3, each = 80)

pfg <- cbind(pfg, i)

pfg <- pfg %>% rename(ISO3 = i)

# Creating data used to rank country press freedoms

pfg.rankings <- pfg %>%
    group_by(year) %>%
    filter(measure %in% "Total_Score") %>%
    arrange(year, score) %>%
    mutate(ranking = row_number())

# Creating the Map Data
pfgts <- pfg %>% filter(measure %in% "Total_Score")
pal <- colorBin("YlOrRd", domain = pfgts$score, bins = 5)


# Creates data for yearly press freedom trends with rAMCharts

pfgam <- spread(pfg, measure, score)
pfgam$year <- as.POSIXct(paste(pfgam$year), format = "%Y")

# Interactive Data Table

pfgt <- pfg %>%
    group_by(year, country, measure) 

pfgtable <- spread(pfgt, measure, score)
pfgtable$Status <- NULL

# Dashboard

header <- dashboardHeader(title = span(tagList(icon("calendar"), "Press Freedom Index")))

sidebar <- dashboardSidebar(
    sidebarMenu(
        menuItem("World Map", tabName = "map"),
        menuItem("Historical Score Data by Year", tabName = "score"),
        menuItem("Country Rankings", tabName = "rankings"),
        menuItem("Data Table", tabName = "table")
    )
)

body <- dashboardBody(
    tabItems(
        tabItem(tabName = "map",
                leafletOutput("worldmap", height = 1000),
                absolutePanel(top = 490, right = '73%', height = 100, width =  100, fixed = FALSE,
                              knobInput(
                                  inputId = "year",
                                  label = "",
                                  value = 2016,
                                  min = 2001,
                                  max = 2016,
                                  displayPrevious = FALSE, 
                                  lineCap = "round",
                                  fgColor = "#F37C05",
                                  bgColor = "FFFFFF",
                                  inputColor = "#F37C05",
                                  width = 100,
                                  height = 100,
                                  immediate = FALSE
                              ))
        ),
        tabItem(tabName = "score",
                fluidRow(
                    box(title = "Press Freedom Index", solidHeader = TRUE, status = "warning", width = 12,
                        h1('Looking at Year By Year Trends in Press Freedoms'),
                        p('The data used for this application is provided by Freedom House
                    and can be accessed with this link:'),
                        strong('https://freedomhouse.org/report-types/freedom-press'),

                        p('Scores on press freedoms have been measured and determined through the context of three different environments:'),

                        tags$li('Legal (range of 1 - 30)'),
                        tags$li('Political (range of 1 - 40)'),
                        tags$li('Environment (range of 1 - 30)'),

                        p('Countries with a higher score indicate lower amounts of freedom. Total scores
are therefore assigned out of 100 - countries with greater amounts of press freedoms have lower scores and countries 
with lesser amounts of press freedoms have higher scores.'),
                        amChartsOutput("score", height = 520),
                        absolutePanel(top = 80, right = 70, fixed = FALSE,
                                      selectInput("country", "Select a Country", choices = levels(pfgam$country), width = 200))
                    )
                )
        ),
        tabItem(tabName = "rankings",
                fluidRow(
                    box(title = "Country Rankings", solidHeader = TRUE, status = "warning", width = 12,
                        h1('Press Freedoms Relative to Other Countries'),
                        p('Here you can look at how other press freedoms of countries compare with eachother by rank.
                    Adjust the circular knob to select the year, and select adjust the slider range to see a 
                    rank range (For example, select 1 and 10 to see the top 10 countries for press freedoms)'),
                        sliderInput("range", "Select Ranking Range", min = 1, max = 197, value = c(1, 10), step = 1, dragRange = TRUE),

                        amChartsOutput("rank"),
                        absolutePanel(top = 300, right = 70, fixed = FALSE,
                                      knobInput("rankyear", "", min = 2001, max = 2016, value = 2016,
                                                displayPrevious = FALSE, 
                                                lineCap = "round",
                                                fgColor = "#F37C05",
                                                bgColor = "FFFFFF",
                                                inputColor = "#F37C05",
                                                width = 100,
                                                height = 100,
                                                immediate = FALSE)
                        )

                    )
                )),
        tabItem(tabName = "table",
                fluidRow(
                    box(title = "Country Data", solidHeader = TRUE, status = "warning", width = 12,
                        h1('Press Freedom Data'),
                        p('Here you can look through country data manually. Use the search bar to filter data.'),
                        DTOutput('table'))
                )
        )
    )
)

# Define UI for application
ui <- dashboardPage(header, sidebar, body, skin = "yellow")

# Define server logic required to draw a histogram
server <- function(input, output) {

    pfgam_re <- reactive({
        pfgam %>% filter(country %in% input$country)
    })

    pfg.rankings_re <- reactive({
        pfg.rankings %>%
            filter(year %in% input$rankyear) %>%
            slice(input$range[1]:input$range[2])
    })

    output$table <- renderDT({
        pfgtable
    })

    output$rank <- renderAmCharts({
        amBarplot(x = ("country"), y = "score", data = pfg.rankings_re(), horiz = TRUE, zoom = TRUE)
    })

    output$score <- renderAmCharts({
        amTimeSeries(pfgam_re(), 'year', c('Political', 'Economic', 'Legal', 'Total_Score'),
                     scrollbar = TRUE, main = paste("Yearly Press Freedom Scores In ", input$country))
    })

    selected <- reactive({
        pfgts <- pfgts %>% filter(year %in% input$year)
    })

    output$worldmap <- renderLeaflet({
        leaflet(options = leafletOptions(minZoom = 2)) %>%
            addMiniMap()

    })

    observe({
        if(!is.null(input$year)){
            map <- joinCountryData2Map(selected(), joinCode = "ISO3",
                                       nameJoinColumn = "ISO3")
            leafletProxy("worldmap", data = map) %>%
                addTiles() %>% 
                clearShapes() %>% 
                addPolygons(fillColor = ~pal(map$score),
                            weight = 2,
                            opacity = 1,
                            color = "white",
                            dashArray = "3",
                            fillOpacity = 0.7,
                            highlight = highlightOptions(
                                weight = 5,
                                color = "white",
                                dashArray = "3",
                                fillOpacity = .8,
                                bringToFront = TRUE),
                            label = ~paste(as.character(map$country),
                                           "Total Index Score: ", as.character(map$score)))
        }})


}



# Run the application 
shinyApp(ui = ui, server = server)

再次,我肯定很沮丧,非常感谢您提供任何帮助!

0 个答案:

没有答案