Shiny 和 ggplot2 - 教程

Question

我正在让自己熟悉 Shiny，但是，熟悉可能有点夸大其词......我尝试了 Shiny 教程，特别是我想将 Lesson 5 改编为我自己的 data。

我创建了一个额外的 R-Script help.R，就像在教程中一样：

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：

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="")？

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