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

Question

我在使用 Shiny 时遇到了一个非常令人沮丧的问题，并试图通过 Checkboxgroup 选择动态绘制数据的应用程序。

首先，这是我的一些数据：

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

现在是我的应用程序：

基本上我使用 CheckboxgroupInput 来选择我想要绘制的多个物种并比较它们的进化。我将直接在代码中解释我的步骤。

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

因此，当我更改选择的物种时，绘图会刷新，但在我堆叠物种时会忽略数据。我的第一个问题是我的 x 轴（年）休息时间与采摘的物种数量一致（1 个物种 = 1 年休息时间，3 个物种 = 3 年休息时间，等等）。

我确实使用并行 TableOutput 跟踪数据演变，同时堆叠更多物种，问题似乎来自子集。我选择了每年调查中观察到的一个物种。添加其他物种（似乎是随机的）使一些年度观察结果完全消失。

我更改了放置子集代码行的位置以获取预过滤数据（在填充部分之前），现在它似乎是随机的，并且在我选择特定物种（没有共同点）时省略了数据。我选择的物种越多，我得到的 x 轴断裂就越少。我以为只保留了共同的年份，但似乎并非如此。基本上，只要我不选择一个以上的物种，我就有完整的数据。

话虽如此，每次我刷新情节时都会收到一条警告消息： “运行中的警告（timeoutMs）：较长的对象长度不是较短对象长度的倍数”

问题是，我故意填充缺失的年份，以使我的向量有足够的长度（每年 1 次观察）。我不知道为什么会收到此警告。

我完全不知道发生了什么。因为我是 Shiny 的新手，所以我可能会错过一些重要的东西。感谢您的帮助！

编辑：没有填充步骤我也有同样的问题。

Answer 1

我认为这可以满足您的需求。我试图简化一些东西。数据子集是在它自己的反应中完成的，并且物种名称被缩短（只是一种可以很容易地改回来的美学）。输入中没有rn，因此该部分已被注释掉。 SUBTOT 不会在此处加载数据，因此应将 dat 分配给全局环境中的数据才能运行。

我不确定你的代码中具体有什么问题，如果不修改我无法重现它，而且它太难阅读了。

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