在Shiny中需要使用updateRadioGroupButtons动态更新下拉选项

分类：编程问答

如何解决在Shiny中需要使用updateRadioGroupButtons动态更新下拉选项

在R Shiny group buttons with individual hover dropdown selection之后，需要根据某些条件动态更新单选按钮。按钮的数量可能会改变。
我至少有以下与以下代码相关的查询。 1）标签是否属于服务器？ 2）如何在服务器代码中动态乘以selectInput？ 3）如何动态乘以输出？我已经更改了您的实现方式，使其更适合我的应用程序。如果要在按钮上显示一个下拉菜单，则所有下拉菜单都有相同的选择，这是在dropdownTRUE中动态计算的。如果dropdownTRUE == F，则不需要下拉菜单。

library(shiny)
library(shinyWidgets)

js <- "
function qTip() {
  $('#THE_INPUT_ID .radiobtn').each(function(i,$el){
    var value = $(this).find('input[type=radio]').val();
    var selector = '#select' + value;
    $(this).qtip({
      overwrite: true,content: {
        text: $(selector).parent().parent()
      },position: {
        my: 'top left',at: 'bottom right'
      },show: {
        ready: false
      },hide: {
        event: 'unfocus'
      },style: {
        classes: 'qtip-blue qtip-rounded'
      },events: {
        blur: function(event,api) {
          api.elements.tooltip.hide();
        }
      }
    });
  });
}
function qTip_delayed(x){
  setTimeout(function(){qTip();},500);
}
$(document).on('shiny:connected',function(){
  Shiny.addCustomMessageHandler('qTip',qTip_delayed);
});
"

ui <- fluidPage(
  
  tags$head( # does this belong to server?
    tags$link(rel = "stylesheet",href = "jquery.qtip.min.css"),tags$script(src = "jquery.qtip.min.js"),tags$script(HTML(js))
  ),br(),uiOutput('bttns'),verbatimTextOutput("selection1")
)

server <- function(input,output,session) {
  
  session$sendCustomMessage("qTip","")
  
  output$bttns<-renderUI({
    bttnchoices=c("A","B","C")
    lenchoice=length(bttnchoices)
    dropdownTRUE=sample(c(T,F),lenchoice,T,rep(.5,2)) ##bttns for which dropdown is to be shown
    dropchoices = c("Apple","Banana")# same choices to be shown for all buttons with dropdownTRUE
    radioGroupButtons(
      inputId = "THE_INPUT_ID",individual = TRUE,label = "Make a choice: ",choices = bttnchoices
    )
    
    div(
      style = "display: none;",shinyInput(lenchoice,selectInput,# struggling with dynamic multiplication of selectInput,lapply?
        "select",label = "Select a fruit",choices=dropchoices,selectize = FALSE
      ))
    
  })

  observeEvent(input[["select1"]],{
    if(input[["select1"]] == "Banana"){
      
      session$sendCustomMessage("qTip","")
      output$bttns<-renderUI({
        bttnchoices=c("D","A")
        lenchoice=length(bttnchoices)
        dropdownTRUE=sample(c(T,2)) 
        dropchoices = c("Peach","Pear") 
        radioGroupButtons(
          inputId = "THE_INPUT_ID",choices = bttnchoices
        )
        
        div(
          style = "display: none;","select",choices = dropchoices,selectize = FALSE
          ))
        
      })
    }
    output$selection1<-input$select1 # struggling with dynamic multiplication of outputs,lapply?
  })
}
  
  shinyApp(ui,server)

解决方法

这是方法。单选按钮的值必须与selectInput的ID的后缀相对应。这里A，B，C，D是值，然后selectInput的id是selectA，selectB ，selectC，selectD。如果要为单选按钮使用其他名称，请执行choices = list("name1" = "A","name2" = "B","name3" = "C","name4" = "D")。

library(shiny)
library(shinyWidgets)

js <- "
function qTip() {
  $('#THE_INPUT_ID .radiobtn').each(function(i,$el){
    var value = $(this).find('input[type=radio]').val();
    var selector = '#select' + value;
    $(this).qtip({
      overwrite: true,content: {
        text: $(selector).parent().parent()
      },position: {
        my: 'top left',at: 'bottom right'
      },show: {
        ready: false
      },hide: {
        event: 'unfocus'
      },style: {
        classes: 'qtip-blue qtip-rounded'
      },events: {
        blur: function(event,api) {
          api.elements.tooltip.hide();
        }
      }
    });
  });
}
function qTip_delayed(x){
  setTimeout(function(){qTip();},500);
}
$(document).on('shiny:connected',function(){
  Shiny.addCustomMessageHandler('qTip',qTip_delayed);
});
"

ui <- fluidPage(

  tags$head(
    tags$link(rel = "stylesheet",href = "jquery.qtip.min.css"),tags$script(src = "jquery.qtip.min.js"),tags$script(HTML(js))
  ),br(),radioGroupButtons(
    inputId = "THE_INPUT_ID",individual = TRUE,label = "Make a choice: ",choices = c("A","B","C")
  ),verbatimTextOutput("selectionA"),verbatimTextOutput("selectionB"),verbatimTextOutput("selectionC"),verbatimTextOutput("selectionD"),div(
    style = "display: none;",selectInput(
      "selectA",label = "Select a fruit",choices = c("Apple","Banana"),selectize = FALSE
    ),selectInput(
      "selectB",choices = c("Lemon","Orange"),selectInput(
      "selectC",choices = c("Strawberry","Pineapple"),selectInput(
      "selectD",choices = c("Pear","Peach"),selectize = FALSE
    )
  )

)

server <- function(input,output,session) {

  session$sendCustomMessage("qTip","")

  output[["selectionA"]] <- renderPrint(input[["selectA"]])
  output[["selectionB"]] <- renderPrint(input[["selectB"]])
  output[["selectionC"]] <- renderPrint(input[["selectC"]])
  output[["selectionD"]] <- renderPrint(input[["selectD"]])

  observeEvent(input[["selectA"]],{
    if(input[["selectA"]] == "Banana"){
      updateRadioGroupButtons(session,inputId = "THE_INPUT_ID",label = "Make NEW choice: ",choices = c("D","A"))
      session$sendCustomMessage("qTip","")
    }
  })

}

shinyApp(ui,server)

编辑

以下方法可以为选定的单选按钮列表设置下拉列表。

library(shiny)
library(shinyWidgets)

js <- "
function qTip(values,ids) {
  $('#THE_INPUT_ID .radiobtn').each(function(i,$el){
    var value = $(this).find('input[type=radio]').val();
    if(values.indexOf(value) > -1){
      var selector = '#' + ids[value];
      $(this).qtip({
        overwrite: true,content: {
          text: $(selector).parent().parent()
        },position: {
          my: 'top left',at: 'bottom right'
        },show: {
          ready: false
        },hide: {
          event: 'unfocus'
        },style: {
          classes: 'qtip-blue qtip-rounded'
        },events: {
          blur: function(event,api) {
            api.elements.tooltip.hide();
          }
        }
      });
    }
  });
}
function qTip_delayed(mssg){
  $('[data-hasqtip]').qtip('destroy',true);
  setTimeout(function(){qTip(mssg.values,mssg.ids);},uiOutput("selections"),uiOutput("dropdowns")

)

server <- function(input,session) {

  dropdowns <- reactiveVal(list( # initial dropdowns
    A = c("Apple",B = c("Lemon",C = c("Strawberry","Pineapple")
  ))

  flag <- reactiveVal(FALSE)
  prefix <- reactiveVal("")

  observeEvent(dropdowns(),{
    if(flag()) prefix(paste0("x",prefix()))
    flag(TRUE)
  },priority = 2)

  observeEvent(input[["selectA"]],"A","B"))
      dropdowns( # new dropdowns,only for D and B
        list(
          D = c("Pear",B = c("Watermelon","Mango")
        )
      )
    }
  })

  observeEvent(dropdowns(),{
    req(dropdowns())
    session$sendCustomMessage(
      "qTip",list(
        values = as.list(names(dropdowns())),ids = setNames(
          as.list(paste0(prefix(),"select",names(dropdowns()))),names(dropdowns())
        )
      )
    )
  })

  observeEvent(dropdowns(),{
    req(dropdowns())
    lapply(names(dropdowns()),function(value){
      output[[paste0("selection",value)]] <-
        renderPrint(input[[paste0(prefix(),value)]])
    })
  })

  output[["dropdowns"]] <- renderUI({
    req(dropdowns())
    selectInputs <- lapply(names(dropdowns()),function(value){
      div(style = "display: none;",selectInput(
            paste0(prefix(),value),choices = dropdowns()[[value]],selectize = FALSE
          )
      )
    })
    do.call(tagList,selectInputs)
  })

  output[["selections"]] <- renderUI({
    req(dropdowns())
    verbOutputs <- lapply(names(dropdowns()),function(value){
      verbatimTextOutput(
        paste0("selection",value)
      )
    })
    do.call(tagList,verbOutputs)
  })

}

shinyApp(ui,server)

enter image description here

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

导入项目后报错问题
依赖报错 idea导入项目后依赖报错，解决方案：https://blog.csdn.net/weixin_42420249/article/details/81191861 依赖版本报错：更换其他版本 无法下载依赖可参考：https://blog.csdn.net/weixin_42628809/a
idea不能识别yaml文件
使用mybatis plus常见错误
错误1：代码生成器依赖和mybatis依赖冲突 启动项目时报错如下 2021-12-03 13:33:33.927 ERROR 7228 [ main] o.s.b.d.LoggingFailureAnalysisReporter : *************************** APPL
gradle常见问题与错误
错误1：gradle项目控制台输出为乱码 # 解决方案：https://blog.csdn.net/weixin_43501566/article/details/112482302 # 在gradle-wrapper.properties 添加以下内容 org.gradle.jvmargs=-Df
Mybatis Plus传入参数0不起作用
错误还原：在查询的过程中，传入的workType为0时，该条件不起作用 &lt;select id=&quot;xxx&quot;&gt; SELECT di.id, di.name, di.work_type, di.updated... &lt;where&gt; &lt;if test=&qu
linux中make编译源码包失败
报错如下，gcc版本太低 ^ server.c:5346:31: 错误：‘struct redisServer’没有名为‘server_cpulist’的成员 redisSetCpuAffinity(server.server_cpulist); ^ server.c: 在函数‘hasActiveC
微服务启动错误：Command line is too long. Shorten command line for
解决方案1 1、改项目中.idea/workspace.xml配置文件，增加dynamic.classpath参数 2、搜索PropertiesComponent，添加如下 &lt;property name=&quot;dynamic.classpath&quot; value=&quot;tru
vue常见错误
删除根组件app.vue中的默认代码后报错：Module Error (from ./node_modules/eslint-loader/index.js): 解决方案：关闭ESlint代码检测，在项目根目录创建vue.config.js，在文件中添加 module.exports = { lin
spark常见错误
查看spark默认的python版本 [root@master day27]# pyspark /home/software/spark-2.3.4-bin-hadoop2.7/conf/spark-env.sh: line 2: /usr/local/hadoop/bin/hadoop: No s
matplotlib报错：AttributeError: module 'backend_interagg' has no attribute 'FigureCanvas'. Did you mean: 'FigureCanvasAgg'?
使用本地python环境可以成功执行 import pandas as pd import matplotlib.pyplot as plt # 设置字体 plt.rcParams[&#39;font.sans-serif&#39;] = [&#39;SimHei&#39;] # 能正确显示负号 p
gitlab登录失败，报错：This challenge page was accidentally cached by an intermediary and is no longer available.
设置时间 控制面板
后端开发常见错误
错误1：Request method ‘DELETE‘ not supported 错误还原：controller层有一个接口，访问该接口时报错：Request method ‘DELETE‘ not supported 错误原因：没有接收到前端传入的参数，修改为如下 参考 错误2：cannot r
docker常见错误
错误1：启动docker镜像时报错：Error response from daemon: driver failed programming external connectivity on endpoint quirky_allen 解决方法：重启docker -&gt; systemctl r
idea常见错误
错误1：private field ‘xxx‘ is never assigned 按Altʾnter快捷键，选择第2项 参考：https://blog.csdn.net/shi_hong_fei_hei/article/details/88814070 错误2：启动时报错，不能找到主启动类 #
pip安装依赖失败
报错如下，通过源不能下载，最后警告pip需升级版本 Requirement already satisfied: pip in c:\users\ychen\appdata\local\programs\python\python310\lib\site-packages (22.0.4) Coll
maven常见错误
错误1：maven打包报错 错误还原：使用maven打包项目时报错如下 [ERROR] Failed to execute goal org.apache.maven.plugins:maven-resources-plugin:3.2.0:resources (default-resources)
cloud项目中常见错误
错误1：服务调用时报错 服务消费者模块assess通过openFeign调用服务提供者模块hires 如下为服务提供者模块hires的控制层接口 @RestController @RequestMapping(&quot;/hires&quot;) public class FeignControl
springboot常见错误
错误1：运行项目后报如下错误 解决方案 报错2：Failed to execute goal org.apache.maven.plugins:maven-compiler-plugin:3.8.1:compile (default-compile) on project sb 解决方案：在pom.
springmvc拦截器中使用redisTemplate报空指针异常
参考 错误原因 过滤器或拦截器在生效时，redisTemplate还没有注入 解决方案：在注入容器时就生效 @Component //项目运行时就注入Spring容器 public class RedisBean { @Resource private RedisTemplate&lt;String
vite报错：npm ERR! command C:WINDOWSsystem32cmd.exe /d /s /c C:UsersychenAppDataLocalTempnpx-dde1c848.cmd
使用vite构建项目报错 C:\Users\ychen\work&gt;npm init @vitejs/app @vitejs/create-app is deprecated, use npm init vite instead C:\Users\ychen\AppData\Local\npm-
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot