Benutzerdefinierte Ausgabe in Shiny

Question

Ich habe diesen Beispiel Datenrahmen:

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) 

Ich mag Mustertext erzeugen, basierend auf diesen Daten, ich den Text für die gesamten Daten machen kann diesen Code verwenden:

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) 

Ausgang ist:

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 

jedoch i Benutzeroption Muster machen basierend auf der Spalte wählt er i geben wollen n das Dropdown (entweder Domäne, ID oder beides). Also, falls er wählt einfach „domain“ sollte die Ausgabe wie:

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 möglich, eine erschöpfende Reihe von Mustern zu hart Code bin in der Lage, aber ich möchte etwas Dynamik, die auf Benutzereingaben reagiert. Jede Hilfe wird sehr geschätzt.

Answer 1

Ein Ansatz konnte ich denken, an der Länge der Eingabe durch den Benutzer gegeben zu betrachten war und schreiben entsprechend unterschiedliche Paste Logik für sie:

Hier mein Ansatz ist:

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)