R:闪亮的复选框组输入子集问题

时间:2015-06-16 14:49:56

标签: r shiny

我正面临一个令人沮丧的问题,使用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>)

现在我的App:

基本上我使用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轴断裂越少。我认为只保留了常年,但似乎并非如此。基本上,只要我不挑选多个物种,我就拥有完整的数据。

话虽如此,每次刷新剧情时我都会收到一条警告信息: &#34;运行时警告(timeoutMs):较长的对象长度不是较短对象长度的倍数&#34;

事情是,我故意填补缺失的年份,以使我的载体足够长(每年1次观察)。我不知道为什么会收到这个警告。

我完全不知道发生了什么。我可能会错过一些很重要的东西,因为我是Shiny的新人。谢谢你的帮助!

编辑:没有填充步骤,我遇到了同样的问题。

1 个答案:

答案 0 :(得分: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")
        )
      )
    )
)

enter image description here