Question

我有这个示例数据框：

domain <- c('ebay.com','facebook.com','auto.com')
id <- c(21000, 23400, 26800)
cost <- c(0.82,0.40,0.57)
test_data <- data.frame(domain,id,cost)

我想基于这些数据生成模式文本，我可以使用以下代码渲染整个数据的文本：

library(shiny)
server <- function(input, output) {

  output$Variables <- renderUI({
    # If missing input, return to avoid error later in function
    choice <- colnames(test_data)[1:2]
    selectInput("Variables1", label = "Choose",choices = choice,multiple = T,selectize = T)
  })
  output$text <-  renderText({

    res <- (paste('if every domain','= "',test_data$domain, '", id in (', test_data$id,'):','<br/>',
                  '&nbsp&nbsp' ,'name: {',"testing",'}' ,'<br/>','&nbsp', '
                  value: ', test_data$cost,'<br/>', sep="", collapse = "
                  el"))
    HTML(paste(res,'else :', '<br/>','&nbsp','value: no_bid'))

  })
}


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      uiOutput("Variables")
    ),
    mainPanel(htmlOutput("text"))
  )
)

shinyApp(ui = ui, server = server)

输出是：

if every domain= "ebay.com", id in (21000):
  name: {testing}
  value: 0.82
elif every domain= "facebook.com", id in (23400):
  name: {testing}
  value: 0.4
elif every domain= "auto.com", id in (26800):
  name: {testing}
  value: 0.57
else : 
  value: no_bid

但是我想让用户根据他在下拉列表中选择的列（域名，ID或两者）来制作模式。因此，如果他只选择“域”，输出应该是：

 if every domain= "ebay.com":
      name: {testing}
      value: 0.82
    elif every domain= "facebook.com":
      name: {testing}
      value: 0.4
    elif every domain= "auto.com":
      name: {testing}

  value: 0.57
else : 
  value: no_bid

我能够硬编码一组可能的模式，但我想要一些能够响应用户输入的动态。任何帮助都非常感谢。

Answer 1

我能想到的一种方法是查看用户给出的输入长度，并为其编写不同的粘贴逻辑：

这是我的方法：

server <- function(input, output) {

  output$Variables <- renderUI({
    # If missing input, return to avoid error later in function
    choice <- colnames(test_data)[1:2]
    selectInput("Variables1", label = "Choose",choices = choice,multiple = T,selectize = T)
  })

  data <- reactive ({
    data1 <-test_data[names(test_data) %in% c(input$Variables1,"cost")]
    # data_final[,-which(names(data_final) %in% c("uid","revenue"))],
    return(data1)
  })


  output$text <-  renderText({
    test_data <- data()
    res <- ifelse(length(input$Variables1)==2,(paste('if every', " ",colnames(test_data)[1],'= "',test_data[,1], '",',colnames(test_data)[2],' ="', test_data[,2],'":','<br/>',
                  '&nbsp&nbsp' ,'name: {',"testing",'}' ,'<br/>','&nbsp', '
    value: ', test_data$cost,'<br/>', sep="", collapse = "
                  el")),(paste('if every ', colnames(test_data)[1],'= "',test_data[,1],'":','<br/>',
                               '&nbsp&nbsp' ,'name: {',"testing",'}' ,'<br/>','&nbsp', '
                               value: ', test_data$cost,'<br/>', sep="", collapse = "
                               el")))

    HTML(paste(res,'else :', '<br/>','&nbsp','value: no_bid'))

  })
  data_test1 <- reactive({
  test_data <- data()
  res <- ifelse(length(input$Variables1)==2,(paste('if every', " ",colnames(test_data)[1],'= "',test_data[,1], '",',colnames(test_data)[2],' ="', test_data[,2],'":','<br/>',
                                                   '&nbsp&nbsp' ,'name: {',"testing",'}' ,'<br/>','&nbsp', '
                                                   value: ', test_data$cost,'<br/>', sep="", collapse = "
                                                   el")),(paste('if every ', colnames(test_data)[1],'= "',test_data[,1],'":','<br/>',
                                                                '&nbsp&nbsp' ,'name: {',"testing",'}' ,'<br/>','&nbsp', '
                                                                value: ', test_data$cost,'<br/>', sep="", collapse = "
                                                                el")))

  data1 <- (HTML(paste(res,'else :', '<br/>','&nbsp','value: no_bid')))
  data1
  })

  output$mytable = renderDataTable({
    data_test1()
  })


}


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      uiOutput("Variables")
    ),
    mainPanel(dataTableOutput('mytable'),htmlOutput('text'))
  )
)

shinyApp(ui = ui, server = server)

用户定义的Shiny输出

1 个答案: