Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Shiny and ggplot2 - Tutorial

I'm making myself familiar with Shiny, however, familiar might be a bit of an overstatement... I tried the Shiny Tutorials, specially I'd like to adapt Lesson 5 for my own data.

I created an additional R-Script help.R, like in the 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)
}

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

And my 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])
    })
  }
)

But that does not even remotely work:

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

What am I doing wrong? Thanks in advance.

like image 821
Thomas Avatar asked Sep 30 '22 13:09

Thomas


1 Answers

Instead of passing the data directly to percent_map, pass the column name. It'll also be faster since it avoids extra copying. Here's a modified function:

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
}

And a fix for 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)
    })
  }
)

As a side note, legend argument is not currently used, did you mean labs(title=legend, x="", y="")?

Anyway, it now runs without errors.

like image 128
tonytonov Avatar answered Oct 03 '22 16:10

tonytonov