分类导航

程序问答发布时间：2022-06-02 发布网站：大佬教程 code.js-code.com

大佬教程收集整理的这篇文章主要介绍了下拉输入不产生任何输出 - Shiny，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

如何解决下拉输入不产生任何输出 - Shiny？

开发过程中遇到下拉输入不产生任何输出 - Shiny的问题如何解决？下面主要结合日常开发的经验，给出你关于下拉输入不产生任何输出 - Shiny的解决方法建议，希望对你解决下拉输入不产生任何输出 - Shiny有所启发或帮助；

我正在创建一个闪亮的应用程序，它连接到存储在 MysqL 中的数据库。该应用程序从三个文件中提取：global.R、ui.R 和 server.R。

我创建了一个数据表显示，它显示了数据库中的数据，并基于 this question 的解决方案中给出的框架，增加了一列下拉菜单。目标是让用户在这些下拉菜单中的输入更改存储在同一行不同列中的数据，并使该更改也反映在数据库中。

目前，下拉菜单中的用户输入未反映在任何类型的输出中，我不确定如何解决此问题。任何帮助和建议将不胜感激！

代码和截图如下：

全局.R

library(pool)
library(shiny)
library(tIDyversE)
library(shinydashboard)
library(DT)

pool <- pool::dbPool(RMysqL::MysqL(),dbname = 'vAndy_recruit_db',host = '127.0.0.1',username = 'root',password = '')

onStop(function() {
  pool::poolClose(pool)
})

ui.R

dashboardPage(
  skin = 'black',dashboardheader(title = 'Vanderbilt RecruiTing'),dashboardSIDebar(
    sIDebarMenu(
      menuItem('Home',tabname = 'home',icon = icon('home')),menuItem('Newly Added',tabname = 'newly_added',icon = icon('plus')),menuItem('top Athletes',tabname = 'top_athletes',icon = icon('football-ball')),menuItem('position Fits',tabname = 'position_fits',icon = icon('check')),menuItem('Maps',tabname = 'maps',icon = icon('map-marked-alt')),menuItem('Watch List',tabname = 'watch_List',icon = icon('eye')),menuItem('HIDden',tabname = 'hIDden',icon = icon('eye-slash')),menuItem('Search',tabname = 'search',icon = icon('search'))
    )
  ),dashboardBody(
    tabItems(
      
      #Home tab content
      tabItem(
        tabname = 'home',Tags$img(height = 100,weight = 100,src = 'vAndy.png',style="display: block; margin-left: auto; margin-right: auto;"),h2('Vanderbilt RecruiTing Dashboard',align = 'center'),h4('Functionality to be added.',align = 'center')
      ),#Newly Added tab content
      tabItem(
        tabname = 'newly_added',fluIDPage(
          datatabLeoutput('newly_added_table'),actionbutton(inputID = "btnProcess",label = "Process",style = "float",size = "sm",color = "success"),actionbutton(inputID = "btnCancel",label = "Cancel",color = "warning"),verbatimtextoutput('sel'),style = 'overflow-y: scroll;overflow-x: scroll;',height = '100%')
        
      )
    )
  )
)

server.R

shinyServer(
  function(input,output,session) {
    
    na_table <- tibble(pool %>% 
                         tbl('player') %>% 
                         as.data.frame() %>% 
                         left_join(pool %>% tbl('height') %>% as.data.frame(),by = 'zcruit_ID') %>% 
                         left_join(pool %>% tbl('weight') %>% as.data.frame(),by = 'zcruit_ID') %>% 
                         left_join(pool %>% tbl('commitment') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('school') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('forty') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('shuttle') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('vertical') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('broad') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('three_cone') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('wingspan') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('arm') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('hand') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('powerball') %>% as.data.frame(),by = 'zcruit_ID') %>%
                         left_join(pool %>% tbl('academics') %>% as.data.frame(),by = 'zcruit_ID') %>% 
                         SELEct(zcruit_ID,full_name,grad_year,position,height,weight,committed_to,hs_juco,school_name,school_city,school_state,forty_yard_dash,shuttle,vertical_jump,broad_jump,three_cone,wingspan,arm_length,hand_size,powerball_toss,gpa,act,sat,watch,hIDe,last_edited)
    ) %>% head()
    
    na_table <- na_table %>% 
      mutate(status_SELEctor = 'NA') %>% 
      SELEct(status_SELEctor,everything())
    
    for(i in 1:nrow(na_tablE)) {
      na_table$status_SELEctor[i] <- as.character(SELEcTinput(paste0("sel",i),"",choices = c('None','Watch','HIDe'),wIDth = "100px"))
    }
    
    output$newly_added_table <- renderDatatable(na_table,SELEction = 'none',escape = F,options = List(
                                                  dom = 't',paging = F,ordering = F
                                                ),callBACk = Js(
                                                  "table.rows().every(function(i,tab,row) {
                        var $this = $(this.node());
                        $this.attr('ID',this.data()[0]);
                        $this.addClass('shiny-input-container');
                      });
                      Shiny.unbindAll(table.table().node());
                      Shiny.bindAll(table.table().node());"
                                                ),filter = 'top')    
    
    output$sel = renderPrint({
      str(sapply(1:nrow(na_tablE),function(i) input[[paste0('sel',i)]]))
    })
    
  }
)

在用户输入之后，NulL 字段应根据选择的下拉值进行更改，但未显示该更改：

https://i.stack.imgur.com/Otx82.png

虽然 NulL 的列表与我最终想要完成的事情无关，但它表明此时用户输入基本上没有任何作用。理想情况下，我希望用户更改下拉值并单击过程以触发其他列中的更改（“监视”下拉值会将监视列从 0 更改为 1，同样隐藏下拉值会将隐藏列从 0 更改为1，下拉值 none 应该在 watch 和 hIDe 列中都有值 0）。单击流程按钮后，这些更改应反映在仪表板显示和数据库中。如果选择取消，则任何最近的下拉更改都将重置。此外，数据表的任何过滤器更改或排序不应重置最近的下拉输入，它们只能在单击处理或取消操作按钮后重置。