User defined Output in Shiny

Question

I have this sample data frame :

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)

I want to generate pattern text based on this data, i can render the text for the entire data using this code :

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)

Output is :

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

However i want to give user option to make pattern based on the column he chooses in the drop down (either domain, id or both). So in case he just chooses "domain" the output should be like :

 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

I am able to hard code an exaustive set of patterns possible , but i want something dynamic which responds to user input. Any help is highly appreciated.

Answer 1

One approach i was able to think of was to look at the length of the input given by user and accordingly write different paste logic for it :

Here is my approach:

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)