Shiny and ggplot2 - Tutorial

Question

Zaprzyjaźniałem się z Shiny, jednak znajomy może być trochę przesadny ... Próbowałem Shiny Tutorials, specjalnie chciałbym dostosować Lesson 5 dla mojego własnego data.

stworzyłem dodatkową R-Script help.R, jak w tutorialu:

percent_map <- function(var, color, legend, min = 0, max = 100) { 

# constrain gradient to percents that occur between min and max 
var <- pmax(var, min) 
var <- pmin(var, max) 

#plot 
aha <- ggplot(abst, aes(long,lat, group=group))+ 
     geom_polygon(aes(fill=var))+ 
     coord_fixed()+ 
     scale_fill_gradient(low = "lightskyblue", high = color, 
        space = "Lab", na.value = "lightblue")+ 
     labs(title=var, x="", y="")+ 
     theme(axis.text=element_blank(), 
     axis.ticks=element_blank(), 
     panel.grid.minor = element_blank(), 
     panel.background = element_blank() 
     ) 
print(aha) 
} 

My ui.R:

library(shiny) 

# Define UI for application that draws a histogram 
shinyUI(fluidPage(
titlePanel("Ja-Anteil von Abstimmungen"), 

sidebarLayout(
sidebarPanel(
    helpText("Create maps with information from ballot outcomes."), 

    selectInput("var", 
       label = "Choose a variable to display", 
       choices = c("Epidemiegesetz", 
          "BG", 
          "1:12", 
          "Familien", 
          "Nationalstrassenabgabegesetz"), 
       selected = "Epidemiegesetz"), 

    sliderInput("range", 
       label = "Range of interest:", 
       min = 0, max = 100, value = c(0, 100)) 

), 

mainPanel(plotOutput("map")) 
) 
)) 

i mój server.R:

library(ggplot2) 

abst <- readRDS("~/try.RDS") 
abst$KANTONSNR <- as.numeric(abst$KANTONSNR) 

source("~/help.R") 

library(shiny) 

shinyServer(
function(input, output) { 
output$map <- renderPlot({ 
    data <- switch(input$var, 
       "Epidemiegesetz" = abst$Epidemiegesetz, 
       "BG" = abst$BG, 
       "1:12" = abst$Loehne, 
       "Familien" = abst$Familien, 
       "Nationalstrassenabgabegesetz" = abst$Nationalstrassenabgabegesetz) 

    color <- switch(input$var, 
        "Epidemiegesetz" = "darkgreen", 
        "BG" = "red", 
        "1:12" = "darkorange", 
        "Familien" = "darkviolet", 
        "Nationalstrassenabgabegesetz" = "darkblue") 

    legend <- switch(input$var, 
        "Epidemiegesetz" = "Epidemiegesetz", 
        "BG" = "BG", 
        "1:12" = "Sozis", 
        "Familien" = "Familien", 
        "Nationalstrassenabgabegesetz" = "blablabla") 

    percent_map(var = data, color = color, max = input$range[2], min = input$range[1]) 
    }) 
    } 
) 

ale to nie nawet zdalnie działa:

Error: arguments imply differing number of rows: 0, 179493 

Co robię źle? Z góry dzięki.

Answer 1

Zamiast przekazywać dane bezpośrednio na numer percent_map, należy podać nazwę kolumny. Będzie również szybszy, ponieważ pozwoli uniknąć dodatkowego kopiowania. Oto zmodyfikowana funkcja:

percent_map <- function(var, color, legend, min = 0, max = 100) { 

    # constrain gradient to percents that occur between min and max 
    abst$tmp_var <- abst[[var]] 
    abst$tmp_var <- pmax(abst$tmp_var, min) 
    abst$tmp_var <- pmin(abst$tmp_var, max) 

    #plot 
    aha <- ggplot(abst, aes(long, lat, group=group))+ 
    geom_polygon(aes(fill = tmp_var))+ 
    coord_fixed()+ 
    scale_fill_gradient(low = "lightskyblue", high = color, 
         space = "Lab", na.value = "lightblue")+ 
    labs(title=var, x="", y="")+ 
    theme(axis.text=element_blank(), 
      axis.ticks=element_blank(), 
      panel.grid.minor = element_blank(), 
      panel.background = element_blank() 
    ) 
    print(aha) 
    abst$tmp_var <- NULL 
} 

Poprawka dla server.R.

shinyServer(
    function(input, output) { 
    output$map <- renderPlot({ 
     data <- switch(input$var, 
        "Epidemiegesetz" = "Epidemiegesetz", 
        "BG" = "BG", 
        "1:12" = "Loehne", 
        "Familien" = "Familien", 
        "Nationalstrassenabgabegesetz" = "Nationalstrassenabgabegesetz") 

     color <- switch(input$var, 
         "Epidemiegesetz" = "darkgreen", 
         "BG" = "red", 
         "1:12" = "darkorange", 
         "Familien" = "darkviolet", 
         "Nationalstrassenabgabegesetz" = "darkblue") 

     legend <- switch(input$var, 
         "Epidemiegesetz" = "Epidemiegesetz", 
         "BG" = "BG", 
         "1:12" = "Sozis", 
         "Familien" = "Familien", 
         "Nationalstrassenabgabegesetz" = "blablabla") 

     percent_map(var = data, color = color, max = input$range[2], min = input$range[1], legend = legend) 
    }) 
    } 
) 

Na marginesie, legend argument nie jest aktualnie używany, miałaś na myśli labs(title=legend, x="", y="")?

W każdym razie teraz działa bez błędów.