Я создаю shinyapp, и я хотел бы отобразить коробчатую диаграмму и таблицу anova на основе выбора, сделанного пользователем. В настоящий момент мой selectInput работает, и я рисую коробочные диаграммы, но я получаю сообщение об ошибке с моей anova. Я добавил несколько сообщений для печати, чтобы помочь с отладкой, и, возможно, это связано с реактивными переменными.

В первый раз, когда он печатается, у меня пустая переменная otu, и поэтому моя таблица данных dfM.sub пуста.

Любая помощь приветствуется.

Вот несколько примеров данных:

> dput(f_genus[,1:10])
structure(list(Acaulospora = c(0, 0, 0, 0, 0, 0, 2.26747086299941e-05, 
0, 0, 0, 0, 0, 0.000120048019207683, 0, 0, 0.000766283524904215, 
0.000207569362762056, 0, 0, 6.24375624375624e-05, 0, 0, 0.000163478829491581, 
0, 8.6884747382597e-05, 0.000185431282257317), Acaulosporaceae_unclassified = c(1.833415837046e-05, 
0, 0, 0, 0, 2.23338916806253e-05, 2.26747086299941e-05, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Acremonium = c(0.00060502722622518, 
0.000363538956069187, 0.000367167850782985, 0.000292958736761927, 
0.000361125862984599, 0.000781686208821887, 0.000453494172599882, 
0.00042863266180883, 0.000702540856096215, 0.000124340992738486, 
0.000492340320778655, 0.00226802090523617, 0.00260104041616647, 
0.00295825967747754, 0.00592563133823822, 0.00322645694696511, 
0.00294056597246246, 0.000659568453783096, 0.00360192642357036, 
0.00118631368631369, 0.00338657501010918, 0.00288747723335258, 
0.00245218244237371, 0.00536866754240676, 0.00364915939006907, 
0.00361591000401768), Acrocalymma = c(0, 0, 0, 0, 4.24853956452469e-05, 
0, 4.53494172599882e-05, 0, 0, 0, 3.78723323675889e-05, 0, 0.00040016006402561, 
0.000252534362711498, 0, 0, 0, 0, 0, 0.000187312687312687, 0, 
0.000888454533339256, 0.000122609122118686, 0.000456907875949512, 
0, 0.000494483419352845), Agaricales_unclassified = c(0, 0, 1.83583925391493e-05, 
0.000190423178895253, 8.49707912904939e-05, 2.23338916806253e-05, 
0.000408144755339894, 0.000782720512868298, 0.000351270428048107, 
0.000522232169501641, 0.000473404154594861, 0.0141997830588699, 
0.0251300520208083, 0.0215375735055377, 0.0124080334062438, 0.00786448880822747, 
0.0132498443229779, 0.0143220578535758, 0.00882269618357683, 
0.00705544455544456, 0.0143044884755358, 0.00266536360001777, 
0.00470001634788295, 0.0275858130104518, 0.0296711412311569, 
0.0323886639676113), Agaricomycetes_unclassified = c(5.500247511138e-05, 
1.91336292667993e-05, 3.67167850782985e-05, 5.85917473523854e-05, 
0.000106213489113117, 0.000111669458403127, 0.000113373543149971, 
0.000969082539741702, 0, 4.97363970953944e-05, 1.89361661837944e-05, 
0.0132136870131151, 0.0112444977991196, 0.00999314549586926, 
0.00914694770332074, 0.0140350877192982, 0.0126963260222791, 
0.012060680297748, 0.00392569509085758, 0.00842907092907093, 
0.0253740396279822, 0.00946204078006308, 0.0042504495667811, 
0.0116511508367125, 0.00886224423302489, 0.00750996693142133), 
    Agrocybe = c(0, 0, 0.000128508747774045, 0, 0.00424853956452469, 
    0.0017643774427694, 0, 0.000223634432248085, 5.01814897211582e-05, 
    0.00131801452302795, 0, 0, 0, 3.60763375302139e-05, 0, 0.0014519056261343, 
    0, 0, 0.0226233356266947, 0.000187312687312687, 0.00161746866154468, 
    0.00186575452001244, 0.00122609122118686, 0, 0, 0), Alatospora = c(0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0.000285567422468445, 0.000173769494765194, 0.000154526068547764
    ), Alternaria = c(0.00022000990044552, 0.000401806214602786, 
    0.0012667290852013, 0.000893524147123878, 0.000191184280403611, 
    0.000402010050251256, 0.000294771212189923, 0.000242270634935426, 
    0.000150544469163475, 0.000223813786929275, 0.00160957412562253, 
    0.00157775367320777, 0.000640256102440976, 0.00194812222663155, 
    0.00039769337840525, 0.00221818915103852, 0.00214488341520792, 
    0.00179025723169698, 0.00165931441984702, 0.00224775224775225, 
    0.00409421754953498, 0.00151037270667674, 0.00114435180644107, 
    0.000628248329430579, 0.000738520352752074, 0.00135982940322032
    ), Amphisphaeriaceae_unclassified = c(0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0.000240096038415366, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0.000912289847517268, 0.000649009487900609)), .Names = c("Acaulospora", 
"Acaulosporaceae_unclassified", "Acremonium", "Acrocalymma", 
"Agaricales_unclassified", "Agaricomycetes_unclassified", "Agrocybe", 
"Alatospora", "Alternaria", "Amphisphaeriaceae_unclassified"), class = "data.frame", row.names = c("R-B1", 
"R-B2", "R-B3", "R-BF-1", "R-BF-2", "R-BF-3", "R-BFi-1", "R-BFi-2", 
"R-Bi-1", "R-Bi-2", "R-Bi-3", "S-B1", "S-B2", "S-B3", "S-Bi-1", 
"S-Bi-2", "S-Bi-3", "S-BF-1", "S-BF-2", "S-BF-3", "S-BFi-1", 
"S-BFi-2", "S-BFi-3", "S1", "S2", "S3"))

И метаданные:

> dput(sample_metadata)
structure(list(Location = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L), .Label = c("Root", "Soil"), class = "factor"), 
    Bean = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
    2L, 2L), .Label = c("Bean", "No bean"), class = "factor"), 
    Fungi = structure(c(2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
    2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    2L, 2L), .Label = c("Fungi", "NF"), class = "factor"), Insect = structure(c(2L, 
    2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L), .Label = c("Insect", 
    "NI"), class = "factor")), .Names = c("Location", "Bean", 
"Fungi", "Insect"), class = "data.frame", row.names = c("R-B1", 
"R-B2", "R-B3", "R-BF-1", "R-BF-2", "R-BF-3", "R-BFi-1", "R-BFi-2", 
"R-BFi-3", "R-Bi-1", "R-Bi-2", "R-Bi-3", "S-B1", "S-B2", "S-B3", 
"S-BF-1", "S-BF-2", "S-BF-3", "S-BFi-1", "S-BFi-2", "S-BFi-3", 
"S-Bi-1", "S-Bi-2", "S-Bi-3", "S1", "S2", "S3"))

Вот ошибки:

 Listening on http://127.0.0.1:7179
Warning in is.na(e2) :
  is.na() applied to non-(list or vector) of type 'NULL'
Warning: Error in : Faceting variables must have at least one value
Stack trace (innermost first):
    111: combine_vars
    110: plyr::unrowname
    109: f
    108: self$compute_layout
    107: f
    106: self$facet$train
    105: f
    104: layout$setup
    103: ggplot2::ggplot_build
    102: print.ggplot
    101: print
     90: <reactive:plotObj>
     79: plotObj
     78: origRenderFunc
     77: output$plot
      1: runApp
[1] "otu selected: "

    Warning in is.na(e2) :
      is.na() applied to non-(list or vector) of type 'NULL'
    [1] "dim dfM.sub:  0" "dim dfM.sub:  6"
    Warning: Error in contrasts<-: contrasts can be applied only to factors with 2 or more levels
    Stack trace (innermost first):
        87: contrasts<-
        86: model.matrix.default
        85: model.matrix
        84: stats::lm
        83: eval
        82: eval
        81: aov
        80: renderTable [/..../shiny/app.R#137]
        79: func
        78: origRenderFunc
        77: output$table
         1: runApp
    [1] "otu selected: Metarhizium"
    [1] "dim dfM.sub:  23" "dim dfM.sub:  6"

Как видите, dfM.sub имеет 2 уровня для всех факторов>

> str(dfM.sub)
'data.frame':   26 obs. of  6 variables:
 $ Location: Factor w/ 2 levels "Root","Soil": 1 1 1 1 1 1 1 1 1 1 ...
 $ Bean    : Factor w/ 2 levels "Bean","No bean": 1 1 1 1 1 1 1 1 1 1 ...
 $ Fungi   : Factor w/ 2 levels "Metarhizium",..: 2 2 2 1 1 1 1 1 2 2 ...
 $ Insect  : Factor w/ 2 levels "Insect","NI": 2 2 2 2 2 2 1 1 1 1 ...
 $ variable: Factor w/ 384 levels "Acaulospora",..: 169 169 169 169 169 169 169 169 169 169 ...
 $ abund   : num  0.00548 0.00377 0.00415 0.00333 0.0044 ...

Вот мой код на данный момент:

    # ========================= LOAD REQUIRED PACKAGES, DATA AND FUNCTIONS ####
#  load necessary packages
library('shiny')
library('ggplot2')
library('reshape2')
library("data.table")
library("dplyr")
library("vegan")
library("gdata")
#
library(shinyjs)
library(logging)
#
# library("stringr")
# load reference data
# none right now
# Load experimental data (abundance tables)
# first row is the header, and first column is rownames (ie. doesn't need corresponding column name)
f_genus<-read.table("b_Genus.csv",header=T,sep=",",row.names=1)
f_family<-read.table("b_Family.csv",header=T,sep=",",row.names=1)
f_phylum<-read.table("b_Phylum.csv",header=T,sep=",",row.names=1)
# read in bacterial data
bact_genus<-read.table("ss_Genus.csv",header=T,sep=",",row.names=1)
bact_family<-read.table("ss_Family.csv",header=T,sep=",",row.names=1)
bact_phylum<-read.table("ss_Phylum.csv",header=T,sep=",",row.names=1)
# sample metadata
sample_metadata<-read.csv("sample_metadata.csv",row.names=1,header=T)
##
abundance_tables<-list(fungi_genus=f_genus,fungi_family=f_family,fungi_phylum=f_phylum,
                       bact_genus=bact_genus,bact_family=bact_family,bact_phylum=bact_phylum)
## add diversity and species count columns to each abundance table
abundance_tables<-lapply(abundance_tables,function(tab) {tab$diversity<-diversity(tab) ; tab})
abundance_tables<-lapply(abundance_tables,function(tab){                           
                          tab$species_count<-apply(tab,1, function(x) {length(x[x>0])});tab})
##
FactorsOfInt<-c("Metarhizium","Insect","Sample_Type","Metarhizium*Insect","Metarhizium*Sample_Type")
# =========================  UI  ####
ui <- fluidPage(
  # Make a title to display in the app
  titlePanel(" Exploring the Effect of Metarhizium on the Soil and Root Microbiome "),
  # Make the Sidebar layout
  sidebarLayout(
    # Put in the sidebar all the input functions
    sidebarPanel(
      tabsetPanel(id="tabs",
        tabPanel("otu", selectInput('dataset', 'dataset', names(abundance_tables),selected=names(abundance_tables)[1]),
                 uiOutput("otu"), br(),
                 # Add comment
                 p("For details on OTU identification please refer to the original publications")),
        tabPanel("anova", sliderInput('pval','p-value for significance',
                                      value=0.1,min=0,max=0.5,step=0.00001),
                 selectInput('dataset', 'dataset', names(abundance_tables)),
                 selectInput('fact_ofInt','factor of interest',FactorsOfInt,selected="Metarhizium"))
        ) 
    ),
    # Put in the main panel of the layout the output functions 
      mainPanel(
        conditionalPanel(condition="input.tabs == 'otu'",
                         plotOutput('plot'),
                            dataTableOutput("table")
        ),
        conditionalPanel(condition="input.tabs == 'anova'",
                         #plotOutput('plot2')
                         verbatimTextOutput("anovaText")
                        # dataTableOutput("anova_tab2")

        )
      )
  )
)
# ========================= SERVER ####
  server <- function(input, output){
    # Return the requested dataset ----
    datasetInput <- reactive({
      abundance_tables[[input$dataset]]
    })
    pvalInput<-reactive({
      input$pval
   })
    comparisonInput<-reactive({
      input$FactorsOfInt
    })
    #
    # output otus to choose basaed on dataset selection
   output$otu <- renderUI({
     selectInput(inputId = "otu", label = "otu",
                       choices = colnames(datasetInput()),selected="Metarhizium")
    })
   otuInput<-reactive({
     input$otu
   })
   output$plot <- renderPlot({
     df<-datasetInput()
     otu<-otuInput()
     ## melt and add sample metadata
     df_annot<-merge(df,sample_metadata,by="row.names",all.x=T)
     rownames(df_annot)<-df_annot[,1]
     df_annot<-df_annot[,-1]
     #
     df_annot<-subset(df_annot,df_annot$Bean =="Bean")
     #
     dfM<-melt(df_annot,id.vars = c("Location","Bean","Fungi","Insect"),value.name="abund")
     # renaming Fungi level to metarhizium
     levels(dfM$Fungi)<-c("Metarhizium","No Meta")
     # subset based on otu of interest
     dfM.sub<-subset(dfM,dfM$variable==otu)
     # 
     ggplot(dfM.sub,aes(x=Insect,y=abund,fill=Fungi))+geom_boxplot()+
       facet_wrap(~Location,scales="free_y" )+
       guides(fill=guide_legend("Metarhizium")) +
       ggtitle(otu)
   })
     ## now make anova table
    output$table <- renderTable({
      df<-datasetInput()
       otu<-otuInput()
      print(paste("otu selected:",otu))
      ## melt and add sample metadata
      df_annot<-merge(df,sample_metadata,by="row.names",all.x=T)
      rownames(df_annot)<-df_annot[,1]
      df_annot<-df_annot[,-1]
      #
      df_annot<-subset(df_annot,df_annot$Bean =="Bean")
      df_annot<-drop.levels(df_annot)
      #
      dfM<-melt(df_annot,id.vars = c("Location","Bean","Fungi","Insect"),value.name="abund")
      # renaming Fungi level to metarhizium
     # levels(dfM$Fungi)<-c("Metarhizium","No Meta")
      # subset based on otu of interest
      dfM.sub<-subset(dfM,dfM$variable==otu)
      print(paste("dim dfM.sub: ",dim(dfM.sub)))
      aov.ex <- aov(dfM.sub$abund~dfM.sub$Fungi)
      anova_table<-as.data.frame(summary(aov.ex)[[1]])
     })
  #### if anova tab selected
  output$anovaText<-renderText({
    "anova Table"
  })


  })
   ### end of server
  }
  ##
 shinyApp(ui=ui,server=server)
1
user2814482 31 Май 2018 в 19:00

1 ответ

Лучший ответ

Основная проблема здесь - несоответствие между dataTableOutput() в пользовательском интерфейсе и renderTable() на сервере. Они всегда должны совпадать; т.е. tableOutput() идет с renderTable(), а dataTableOutput() идет с renderDataTable().

Заменить

conditionalPanel(condition="input.tabs == 'otu'",
                     plotOutput('plot'),
                     dataTableOutput("table")
),

С участием

conditionalPanel(condition="input.tabs == 'otu'",
                     plotOutput('plot'),
                     tableOutput("table")
),

И ваша таблица anova будет отображаться под вашим графиком. В качестве альтернативы вы можете заменить

output$table <- renderTable({
...
})

С участием

output$table <- renderDataTable({
...
})

В любом случае ваша таблица будет отображаться.

Что касается замеченных вами ошибок, вы правы, что они являются реакцией на отсутствие чего-либо в input$otu при загрузке приложения. Чтобы избежать появления ошибок до тех пор, пока приложение не догонит, вы можете потребовать, чтобы input$otu заполнялся перед попыткой построения данных или помещением в таблицу в первой строке внутри ваших вызовов renderPlot() и renderTable(). :

output$plot <- renderPlot({
  req(is.null(input$otu)==F)
  ...
})

Вы заметите, когда приложение загрузится, есть такая же задержка, но ошибок нет.

3
phalteman 6 Июн 2018 в 20:49