闪亮和ggplot2 - 教程

Question

我正在让自己熟悉闪亮，但是，熟悉可能有点夸张......我尝试了闪亮的教程，特别是我想为我自己的data适应Lesson 5。

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

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

而且我server.R：

我在教程中创建一个额外的R-脚本help.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]) 
    }) 
    } 
) 

但是，这并不即使是远程工作：

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

我在做什么错？ 在此先感谢。

Answer 1

不是将数据直接传递给percent_map，而是传递列名称。它也会更快，因为它避免了额外的复制。这里有一个修正功能：

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 
} 

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

作为一个侧面说明，legend说法目前未使用的，你的意思是labs(title=legend, x="", y="")？

无论如何，它现在运行没有错误。