Shiny App Not Working Properly on ShinyApps Server (Countries are Mislabelled on Leaflet Map)

shiny
leaflet
shinyappsio

#1

Hi all,

I am having what seems to be a very strange problem with my shiny app, which is currently on shinyapps.io. You can see it here: https://esbriskin.shinyapps.io/Media_Freedoms/

I am interested in visualizing trends pertaining to press freedoms around the world. I have created an interactive map using Shiny and Leaflet where countries are shaded based off of their press freedom score (darker, redder shades = higher press freedom scores which indicate lower press freedoms overall). When you hover over each country, the name and the score will appear as a label. You can adjust the scores by year by adjusting the orange knob on the bottom.

What's strange is that when I run the app locally on my computer, it works fine, but when I upload it to the server, certain countries are mislabeled and not colored correctly. Here is what it is supposed to look like (when run locally):

However, when it is on the shinyapps server for example, 'Canada' is labelled and colored as 'Cameroon,' 'China' is labelled and colored as 'Chile,' and a few other countries are mislabeled. I have tried troubleshooting multiple aspects - I tried using a world shapefile instead of the 'rworldmap' function, and I joined country data by ISO3 codes as opposed to country names to avoid potential confusion, all with the same result: it works perfectly fine locally but once it's on the shinyapps server, it mislabels these countries.

UPDATE: I have posted the code on RStudio Cloud - you can access it here in addition to below.

Here is also the data which can be directly downloaded.

Here is the code in it's entirety:

# Load Libraries  

library(shiny)
library(shinydashboard)
#> Warning: package 'shinydashboard' was built under R version 3.5.2
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box
library(shinyWidgets)
library(shinythemes)
#> Warning: package 'shinythemes' was built under R version 3.5.2
library(DT)
#> Warning: package 'DT' was built under R version 3.5.2
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(maptools)
#> Loading required package: sp
#> Checking rgeos availability: TRUE
library(rgdal)
#> rgdal: version: 1.3-6, (SVN revision 773)
#>  Geospatial Data Abstraction Library extensions to R successfully loaded
#>  Loaded GDAL runtime: GDAL 2.2.3, released 2017/11/20
#>  Path to GDAL shared files: C:/Users/Eli/Documents/R/win-library/3.5/rgdal/gdal
#>  GDAL binary built with GEOS: TRUE 
#>  Loaded PROJ.4 runtime: Rel. 4.9.3, 15 August 2016, [PJ_VERSION: 493]
#>  Path to PROJ.4 shared files: C:/Users/Eli/Documents/R/win-library/3.5/rgdal/proj
#>  Linking to sp version: 1.3-1
library(rworldmap)
#> Warning: package 'rworldmap' was built under R version 3.5.2
#> ### Welcome to rworldmap ###
#> For a short introduction type :   vignette('rworldmap')
library(leaflet)
library(sp)
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 3.5.2
library(plotly)
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following object is masked from 'package:base':
#> 
#>     date
library(rAmCharts)
#> Warning: package 'rAmCharts' was built under R version 3.5.2
#> Full amcharts.js API available using amChartsAPI()
#> Look at rAmCharts::runExamples() & http://datastorm-open.github.io/introduction_ramcharts/
#> Bug report or feed back on https://github.com/datastorm-open/rAmCharts
#> 
#> Attaching package: 'rAmCharts'
#> The following object is masked from 'package:plotly':
#> 
#>     api
#> The following object is masked from 'package:maptools':
#> 
#>     label
#> The following object is masked from 'package:shinyWidgets':
#> 
#>     panel
library(rsconnect)
#> 
#> Attaching package: 'rsconnect'
#> The following object is masked from 'package:shiny':
#> 
#>     serverInfo

# Reading in the data

setwd("C:/Users/Eli/Desktop/Media_Freedoms")

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)
#> Warning: attributes are not identical across measure variables;
#> they will be dropped

colnames(pfg)[1] = "country"

pfg$score <- as.numeric(pfg$score)
#> Warning: NAs introduced by coercion

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)
#> 
#> Listening on http://127.0.0.1:4229
#> 194 codes from your data successfully matched countries in the map
#> 3 codes from your data failed to match with a country code in the map
#> 50 codes from the map weren't represented in your data

Created on 2019-01-26 by the reprex package (v0.2.1)

I would really appreciate the help, as I am stumped on this problem.


#2

Could you reply with the output of

dput(
  read.csv("Index_Data_2000.csv", header = TRUE)
)

It'll help me debug your code knowing exactly how your data is structured.

Thank you in advance!


#3

This line is very suspicious:

setwd("C:/Users/Eli/Desktop/Media_Freedoms")

This couldn't possibly work on ShinyApps.io...?


#4

Dear Barret,

Unfortunately the dput output for the csv file is too long (it exceeded the post limit). I have a link to the file here for download: https://drive.google.com/file/d/1naPVJ5su31YGx4jNIg7yH5RzEs3hywul/view?usp=sharing

Thank you for the help!

Best,
Eli


#5

Yes, you're right. I just included that in the code as sometimes I work on projects in multiple directories (switching back and forth). I also had to include it for reprex purposes. When I upload to shinyapps.io I make sure to take it out.

-Eli


#6

From outside conversations with esbriskin, this was solved by preprocessing the data and saving that data to a file to be loaded at runtime. This removed the possibility of processing the data incorrectly when deployed on a server.

(No true error solution was found.)


closed #7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.