R：闪亮，复选框组输入子集问题

Question

I'm facing a quite frustrating issue using Shiny and trying to set an App with dynamic plotting of data selected via Checkboxgroup.

First, here's some of my data:

> dput(head(SUBTOT,20))
 structure(list(YEAR = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("2001", 
"2002", "2003", "2004", "2005", "2006", "2007", "2008", "2009", 
"2010", "2011", "2012", "2013", "2014"), class = "factor"), NOM =  structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L), .Label = "RAVIN DE VALBOIS", class = "factor"), 
SP = structure(c(5L, 6L, 6L, 6L, 6L, 6L, 9L, 9L, 9L, 9L, 
9L, 9L, 9L, 11L, 11L, 11L, 11L, 12L, 12L, 12L), .Label = c("Aglais io (Linnaeus, 1758)", 
"Aglais urticae (Linnaeus, 1758)", "Anthocharis cardamines (Linnaeus, 1758)", 
"Apatura ilia ([Denis & Schiffermller], 1775)", "Aphantopus hyperantus (Linnaeus, 1758)", 
"Aporia crataegi (Linnaeus, 1758)", "Araschnia levana (Linnaeus, 1758)", 
"Argynnis adippe ([Denis & Schiffermller], 1775)", "Argynnis aglaja (Linnaeus, 1758)", 
"Argynnis paphia (Linnaeus, 1758)", "Aricia agestis ([Denis & Schiffermller], 1775)", 
"Boloria dia (Linnaeus, 1767)", "Boloria euphrosyne (Linnaeus, 1758)", 
"Brenthis daphne ([Denis & Schiffermller], 1775)", "Brintesia circe (Fabricius, 1775)", 
"Callophrys rubi (Linnaeus, 1758)", "Carterocephalus palaemon (Pallas, 1771)", 
"Celastrina argiolus (Linnaeus, 1758)", "Coenonympha arcania (Linnaeus, 1761)", 
"Coenonympha glycerion (Borkhausen, 1788)", "Coenonympha pamphilus (Linnaeus, 1758)", 
"Colias crocea (Geoffroy in Fourcroy, 1785)", "Colias palaeno (Linnaeus, 1761)", 
"Cupido argiades (Pallas, 1771)", "Cupido minimus (Fuessly, 1775)", 
"Cyaniris semiargus (Rottemburg, 1775)", "Erebia aethiops (Esper, 1777)", 
"Erebia medusa ([Denis & Schiffermller], 1775)", "Erynnis tages (Linnaeus, 1758)", 
"Euphydryas aurinia (Rottemburg, 1775)", "Euplagia quadripunctaria (Poda, 1761)", 
"Glaucopsyche alexis (Poda, 1761)", "Gonepteryx rhamni (Linnaeus, 1758)", 
"Hamearis lucina (Linnaeus, 1758)", "Hesperia comma (Linnaeus, 1758)", 
"Hipparchia C (alcyone / genava / fagi) #complexe", "Iphiclides podalirius (Linnaeus, 1758)", 
"Issoria lathonia (Linnaeus, 1758)", "Lasiommata C (megera / maera) #complexe", 
"Leptidea sinapis (Linnaeus, 1758)", "Libelloides coccajus ([Denis & Schiffermller], 1775)", 
"Limenitis camilla (Linnaeus, 1764)", "Limenitis reducta Staudinger, 1901", 
"Lopinga achine (Scopoli, 1763)", "Lycaena phlaeas (Linnaeus, 1761)", 
"Lycaena tityrus (Poda, 1761)", "Lysandra bellargus (Rottemburg, 1775)", 
"Lysandra coridon (Poda, 1761)", "Maniola jurtina (Linnaeus, 1758)", 
"Melanargia galathea (Linnaeus, 1758)", "Melitaea cinxia (Linnaeus, 1758)", 
"Melitaea didyma (Esper, 1778)", "Melitaea parthenoides Keferstein, 1851", 
"Melitaea phoebe ([Denis & Schiffermller], 1775)", "Mellicta C (athalia / deione / parthenoides) #complexe", 
"Minois dryas (Scopoli, 1763)", "Nymphalis polychloros (Linnaeus, 1758)", 
"Ochlodes sylvanus (Esper, 1777)", "Papilio machaon Linnaeus, 1758", 
"Pararge aegeria (Linnaeus, 1758)", "Pieris 2 (rapae / mannii / napi) #complexe", 
"Pieris brassicae (Linnaeus, 1758)", "Pieris napi (Linnaeus, 1758)", 
"Pieris rapae (Linnaeus, 1758)", "Polygonia c-album (Linnaeus, 1758)", 
"Polyommatus icarus (Rottemburg, 1775)", "Pyrgus 2 C (armoricanus / foulquieri / alveus / onopordi) #complexe", 
"Pyrgus 3 C (serratulae / carlinae / cirsii) #complexe", 
"Pyrgus malvae (Linnaeus, 1758)", "Pyronia tithonus (Linnaeus, 1771)", 
"Quercusia quercus (Linnaeus, 1758)", "Satyrium acaciae (Fabricius, 1787)", 
"Satyrium ilicis (Esper, 1779)", "Satyrium spini ([Denis & Schiffermller], 1775)", 
"Spialia sertorius (Hoffmannsegg, 1804)", "Thecla betulae (Linnaeus, 1758)", 
"Thymelicus acteon (Rottemburg, 1775)", "Thymelicus C (sylvestris / lineolus) #complexe", 
"Vanessa atalanta (Linnaeus, 1758)", "Vanessa cardui (Linnaeus, 1758)", 
"Zygaena carniolica (Scopoli, 1763)", "Zygaena loti ([Denis & Schiffermller], 1775)", 
"Zygaena purpuralis (Brnnich, 1763)"), class = "factor"), 
IA = c(NA, NA, 2.5974025974026, 3.46320346320346, 2.16450216450216, 
0, NA, 81.8181818181818, 10.3896103896104, 3.46320346320346, 
6.49350649350649, 3.46320346320346, 0, NA, 41.991341991342, 
12.1212121212121, 0, NA, 3.03030303030303, 9.09090909090909
)), .Names = c("YEAR", "NOM", "SP", "IA"), class = c("data.table", 
"data.frame"), row.names = c(NA, -20L), .internal.selfref = <pointer: 0x0000000000100788>)

And now my App:

Basically I use CheckboxgroupInput to choose multiples species i want to plot and compare their evolution. I'll explain my steps directly in the code.

Server.R:

shinyServer(function(input, output) {

#Loading datasets
rn <- reactive({input$rn})
SUBTOT<-reactive({
 dataset<- paste("Data_R_IA_",rn(),".Rdata", sep="")
get(load (dataset))})

groupesp <- reactive({input$groupesp})

#Setting my checkbox choices on the species
output$selectUI2 <- renderUI({ 
  checkboxGroupInput("groupesp", "Choisir les espèces:",    levels(SUBTOT()$SP), selected = head(levels(SUBTOT()$SP),3)  )
})

#Plotting
output$plotIAgroup<-renderPlot({
  AGGIA<-aggregate((SUBTOT()$IA)~SUBTOT()$YEAR+SUBTOT()$SP, FUN = sum)
  colnames(AGGIA)<-c("YEAR","SP","IA")
#Isolating all my years as factors
  PERIODE<-levels(SUBTOT()$YEAR)
  PERIODE<-factor(PERIODE)
#Subsetting by the species input
  AGGIA<-subset(AGGIA,SP==groupesp())
  AGGIA$SP<-factor(AGGIA$SP)
#Filling missing years with zeros (for exhaustive plots)
  AGGIA0 <- with(AGGIA, expand.grid(YEAR = PERIODE, SP = levels(AGGIA$SP)))
  AGGIA0 <- merge(AGGIA, AGGIA0, all.y = TRUE)
  AGGIA0$IA[is.na(AGGIA0$IA)] <- 0

  ggplot(AGGIA0, aes(YEAR, IA, group = SP, color = SP))+
    ggtitle(ggtitle(bquote(atop(.("Evolution de l'indice d'abondance"),   atop(italic(.(rn())))) )))+
    theme_bw()+
    geom_line(size=1)+
    geom_point(size=3)+
    theme(legend.direction ="vertical",legend.position = "bottom")+
    guides(color=guide_legend(ncol=2))
})
})

Ui.R:

shinyUI("Appli Rhopalo",position ="static-top", 
sidebarLayout(
        sidebarPanel(htmlOutput("selectUI2") 
        ),   
        mainPanel(     
          plotOutput("plotIAgroup")))

So when i change the species picked, the plot does refresh but omits data when i stack species. My first problem was my x-axis (years) breaks changed inline with the number of species picked (1 species= 1 year break, 3 species= 3 years break, etc).

I did follow the data evolution with a parallel TableOutput while stacking more species and the problem seems to come from the subsetting. I picked one species that had been observed each year of the survey. Adding others species (seems random) made some annual observations simply disapear.

I changed where i put the subsetting code line to get a pre-filtered data (before the filling part), and now it seems to be random and omits data when i pick particular species (that have nothing in common). The more species i pick, the least x-axis breaks i got. I thought only the common years were kept, but it doesn't seem to be that. Basically, i have complete data as long as i don't pick more than one specie.

That being said, i get a warning message everytime i refresh the plot: "Warning in run(timeoutMs) :longer object length is not a multiple of shorter object length"

The thing is, i purposely fill the missing years to get my vectors on the adequate length (1 observation per year). I don't know why i get this warning.

I have completely no clue about what's happening. I might be missing something big since i'm new with Shiny. Thanks for your help!

Edit: I have the same problem without the filling step.

Answer 1

I think this does what you want. I tried to simplify some stuff. The data subsetting is done in its own reactive, and the species names are shortened (just an aesthetic that can easily be changed back). There was no rn in the input, so that part is commented out. SUBTOT doesn't load data here, so dat should be assigned to your data in the global environment for this to run.

I'm not sure what was breaking in your code specifically, I couldn't reproduce it without modification and it was too hard to read.

library(shiny)
library(ggplot2)
shinyApp(
  server=shinyServer(function(input, output) {
    ## Loading datasets - Modified this part to just use the dput() data
    rn <- reactive({input$rn})
    SUBTOT <-reactive({
      dataset <- dat # paste("Data_R_IA_",rn(),".Rdata", sep="")
      ## get(load (dataset))
    })

    ## Do the data subsetting/processing here
    getData <- reactive({
      specs <- specNames()$long[specNames()$short %in% input$groupesp]
      droplevels(SUBTOT()[SUBTOT()$SP %in% specs,])  # ** drop unused factor levels **
    })

    ## Only lists species with data, map shortened names to long names
    specNames <- reactive({
      specs <- names(table(SUBTOT()$SP)[table(SUBTOT()$SP) > 0])
      ns <- gsub("([^(]+).*", "\\1", specs, perl=T)
      list(long=specs, short=ns)
    })

    ## Setting my checkbox choices on the species
    output$selectUI2 <- renderUI({ 
      specs <- specNames()
      checkboxGroupInput("groupesp", "Choisir les espèces:",    
                         specs$short,
                         selected = head(specs$short,3), inline=T)
    })

    ## Plotting
    output$plotIAgroup <- renderPlot({
      dat <- getData()  # this is already subsetted by species
      AGGIA <- aggregate(IA ~ YEAR+SP, data=dat, FUN = sum)

      ## ** Removed stuff here **

      ## Filling missing years with zeros (for exhaustive plots)
      AGGIA0 <- with(AGGIA, expand.grid(YEAR = levels(SUBTOT()$YEAR), 
                                        SP = levels(dat$SP)))  # only use species subset
      AGGIA0 <- merge(AGGIA, AGGIA0, all.y = TRUE)
      AGGIA0$IA[is.na(AGGIA0$IA)] <- 0

      ggplot(AGGIA0, aes(YEAR, IA, group = SP, color = SP))+
        ## ggtitle(ggtitle(bquote(atop(.("Evolution de l'indice d'abondance"),   
        ## atop(italic(.(rn())))) )))+
        theme_bw()+
        geom_line(size=1)+
        geom_point(size=3)+
        theme(legend.direction ="vertical",legend.position = "bottom")+
        guides(color=guide_legend(ncol=2))
    })
  }),

  ui <- shinyUI(# "Appli Rhopalo", #position ="static-top", 
      sidebarLayout(
        sidebarPanel(
          htmlOutput("selectUI2") 
        ),   
        mainPanel(     
          plotOutput("plotIAgroup")
        )
      )
    )
)