2014-06-18 14 views
5

Mi sto familiarizzando con Shiny, tuttavia, familiare potrebbe essere un po 'esagerato ... Ho provato i Tutorial splendidi, in particolare mi piacerebbe adattare per il mio data.Shiny e ggplot2 - Tutorial

ho creato un ulteriore R-Script help.R, come nel tutorial:

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) 
} 

mio 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")) 
) 
)) 

E il mio 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]) 
    }) 
    } 
) 

ma questo non significa funziona anche da remoto:

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

Cosa sto sbagliando? Grazie in anticipo.

+0

Puoi provare a restringere il problema? Ho provato a produrre una trama statica (cioè senza lucido) e ottengo "Errore: valore discreto fornito alla scala continua". Sei sicuro che il codice di stampa funzioni come previsto? – tonytonov

+0

Sono sicuro che la trama funziona se produco una normale mappa ggplot (ovviamente con il comando 'scale_fill_gradient'' high' deve essere specificato. – Thomas

risposta

4

Invece di passare i dati direttamente a percent_map, passare il nome della colonna. Sarà anche più veloce dal momento che evita la copia extra. Ecco una funzione modificata:

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 
} 

E una correzione per 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) 
    }) 
    } 
) 

Come nota a margine, legend argomento non è attualmente utilizzato, volevi dire labs(title=legend, x="", y="")?

Ad ogni modo, ora funziona senza errori.

+0

Grazie mille, funziona - quasi perfetto.La mappa sembra essere unicolor ora, come posso recuperare la gradazione? – Thomas

+0

@Thomas Ho modificato la mia risposta per gestire correttamente la parte 'pmin/pmax' Ora il cursore funziona come previsto – tonytonov

+0

Semplicemente perfetto, grazie @tonytonov – Thomas