search

rstudio / shiny

Easy interactive web applications with R
http://shiny.rstudio.com
Other
5.32k stars 1.87k forks source link

[possible bug] Failing produce one of the tables with different inputs #3409

Closed mahsaashouri closed 3 years ago

mahsaashouri commented 3 years ago

I am trying to make a shiny app and I have a problem while I want it to return two tables (or sometimes plots) with the same codes and different input values. Here is a sample of codes. If you run the codes you can see it just returns one of the tables.

Example application or steps to reproduce the problem

Here is a working example reproduce the problem:

library(shiny)
library("strucchange")
require(partykit)

airq <- subset(airquality,!is.na(Ozone))

ui <- fluidPage(sidebarPanel(
  selectInput(
    "max",
    label = "depth",
    choices = list("2" = "2", "3" = "3", "4" = "4"),
    selected = list("3")

  ),

  selectInput(
    "max2",
    label = "depth2",
    choices = list("2" = "2", "3" = "3", "4" = "4"),

  )),

  mainPanel(tabsetPanel(
    tabPanel("myTable", uiOutput("myTable"))
    ,
    tabPanel("myTable2", uiOutput("myTable2"))
  )))

server <- function(input, output, session) {
  fit1 <- reactive({
    ctree(Ozone ~ .,
          data = airq,
          control=ctree_control(maxdepth =input$max))
  })
  fit2 <- reactive({
    ctree(Ozone ~ .,
          data = airq,
          control=ctree_control(maxdepth = input$max2))
  })
 output$myTable = renderUI({
    test1 <- list()
    for(i in 1:length(sctest(fit1())))
    {test <- sctest(fit1())[i]
    if(nrow(as.data.frame(test))!=0)
      test1[[length(test1)+1]] <- test} 
    names <- c()
    for(i in 1:length(test1)){
      names[i] <- paste0('name', i)
    }
    names(test1) <- names
    lapply(names(test1), function(x) {
      output[[x]] = DT::renderDataTable({DT::datatable(data.frame(test1[[x]])) 
      })
    })

    return(lapply(names(test1), DT::dataTableOutput))
  })
  output$myTable2 = renderUI({
    test1 <- list()
    for(i in 1:length(sctest(fit2())))
    {test <- sctest(fit2())[i]
    if(nrow(as.data.frame(test))!=0)
      test1[[length(test1)+1]] <- test} 
    names <- c()
    for(i in 1:length(test1)){
      names[i] <- paste0('name', i)
    }
    names(test1) <- names
    lapply(names(test1), function(x) {
      output[[x]] = DT::renderDataTable({DT::datatable(data.frame(test1[[x]])) 
      })
    })

    return(lapply(names(test1), DT::dataTableOutput))
  })
}

shinyApp(ui, server)

System details

Output of sessionInfo():

R version 3.6.2 (2019-12-12)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)

Matrix products: default

Random number generation:
 RNG:     L'Ecuyer-CMRG 
 Normal:  Inversion 
 Sample:  Rejection 

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                           LC_TIME=English_United States.1252    

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] imputeTS_3.0          forcats_0.4.0         stringr_1.4.0         purrr_0.3.4           readr_1.3.1          
 [6] tidyr_1.1.0           tibble_3.0.1          tidyverse_1.3.0       data.table_1.12.8     strucchange_1.5-2    
[11] sandwich_2.5-1        dtwclust_5.5.6        dtw_1.21-3            proxy_0.4-24          dendsort_0.3.3       
[16] plyr_1.8.6            reshape2_1.4.4        dplyr_1.0.0           quantmod_0.4.17       TTR_0.23-6           
[21] xts_0.12-0            zoo_1.8-8             ggparty_1.0.0         ggplot2_3.3.1         partykit_1.2-7       
[26] mvtnorm_1.1-0         libcoin_1.0-5         shinythemes_1.2.0     shinydashboard_0.7.1  shinyscreenshot_0.1.0
[31] shiny_1.4.0.2         DT_0.18              

loaded via a namespace (and not attached):
 [1] bigmemory_4.5.36    bigmemory.sri_0.1.3 colorspace_1.4-1    ellipsis_0.3.1      class_7.3-15       
 [6] modeltools_0.2-23   fs_1.3.1            clue_0.3-57         rstudioapi_0.11     ggrepel_0.8.1      
[11] RSpectra_0.16-0     lubridate_1.7.9     xml2_1.3.2          codetools_0.2-16    splines_3.6.2      
[16] Formula_1.2-3       jsonlite_1.7.2      nloptr_1.2.2        broom_0.7.0         cluster_2.1.0      
[21] dbplyr_1.4.2        compiler_3.6.2      httr_1.4.1          backports_1.1.7     assertthat_0.2.1   
[26] Matrix_1.2-18       fastmap_1.0.1       cli_2.5.0           later_1.0.0         htmltools_0.5.1.1  
[31] tools_3.6.2         gtable_0.3.0        glue_1.4.1          Rcpp_1.0.5          cellranger_1.1.0   
[36] fracdiff_1.5-1      vctrs_0.3.1         urca_1.3-0          nlme_3.1-142        crosstalk_1.1.0.1  
[41] iterators_1.0.12    lmtest_0.9-37       timeDate_3043.102   inum_1.0-1          rvest_0.3.5        
[46] mime_0.9            lifecycle_0.2.0     scales_1.1.1        hms_0.5.3           promises_1.1.0     
[51] parallel_3.6.2      yaml_2.2.1          curl_4.3            rpart_4.1-15        stringi_1.4.6      
[56] tseries_0.10-47     foreach_1.5.0       checkmate_2.0.0     rlang_0.4.6         pkgconfig_2.0.3    
[61] lattice_0.20-38     stinepack_1.4       htmlwidgets_1.5.1   tidyselect_1.1.0    magrittr_2.0.1     
[66] R6_2.4.1            generics_0.0.2      DBI_1.1.0           pillar_1.4.4        haven_2.4.0        
[71] withr_2.4.2         survival_3.1-8      nnet_7.3-12         modelr_0.1.5        crayon_1.3.4       
[76] readxl_1.3.1        flexclust_1.4-0     reprex_2.0.0        forecast_8.12       digest_0.6.25      
[81] xtable_1.8-4        httpuv_1.5.4        RcppParallel_5.0.1  stats4_3.6.2        munsell_0.5.0      
[86] quadprog_1.5-8      shinyjs_1.1
mahsaashouri commented 3 years ago

I solved the problem by using a different set of names for the test1 list.