如何解决使用“ Shiny”在每一行中显示带有按钮的数据表,以使给定的数据帧显示如下表所示
这是数据框
sports=data_frame(question=c("<h5>This gives you more information about pro Football
What position would you prefer to play in pro Football?</h5>","</h5>This gives you more information about pro Soccer
What position would you prefer to play in pro Soccer?</h5>","</h5>This gives you more information about pro Hockey
What position would you prefer to play in pro Hockey?</h5>"),`Expected Money`= c(list(c('First Year = 10','First 3 Years= 50')),list(c('First Year = 15','First 4 Years= 50')),NA),`Expected Injury Risk`= c(list(c('Death=0.0001%','Severe= 0.001%')),list(c('Minor=0.01%','Severe= 0.0001%')),list(c('Death=0.00001%','Severe= 0.002%'))),`Field Dimentions`=c( NA,list(c('length=100','width=60')),list(c('length=50','width=30'))),position=c(list(c('QB',"DB","RB","LB")),list(c('Forward','Defender','Goal keeper')),'Winger','Goal Tender')))
)
我要使其如下图所示。我希望不显示带有choices = NA的下拉按钮。每行底部的按钮仅供参考,对于这些响应我不感兴趣。我只会对问题的回答感兴趣,即为哪一行选择了哪个职位。感谢您的帮助!
以下代码无法按我的需要排列信息按钮。仅显示第一个信息按钮。
library(shiny)
library(DT)
library(shinyWidgets)
shinyApp(
ui <- fluidPage(
DT::dataTableOutput("data"),textOutput('myText')
),server <- function(input,output) {
myValue <- reactiveValues(result = '')
shinyInput <- function(FUN,len,id,...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id,i),...))
}
inputs
}
L=NULL
df <- reactiveValues(data = data.frame(
Name = paste('<h5>',c('Dilbert is a dragon with high speed in the air','Alice','Wally','Ashok','Dogbert'),'</h5>',#cbind instead of paste arranges buttons row-wise
cbind(shinyInput(pickerInput,5,'button_',label = "Pets",choices=1:3 ),shinyInput(pickerInput,len=5,id='Friends',label='Friends',choices=LETTERS[1:3] )
)),Res= shinyInput(dropdown,id='Enemies',label = "Enemies")
))
output$data <- DT::renderDataTable(
df$data,server = FALSE,escape = FALSE,selection = 'none'
)
observeEvent(input$select_button,{
selectedRow <- as.numeric(strsplit(input$select_button,"_")[[1]][2])
myValue$result <<- paste('click on ',df$data[selectedRow,1])
})
output$myText <- renderText({
myValue$result
})
}
)
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。