ユーザーがselectizeInputの入力選択を変更できるようにする

Question

このアプリケーションは、ユーザー入力（チャネル数と複製数）を考慮して作成した標準化された名前のベクトルを作成しています。標準名の例は、チャンネル= 4の数を与えられたとし、次のように= 1である複製：

c("rep1_C0","rep1_C1","rep1_C2","rep1_C3") 

私は、ユーザーが独自のカスタム値を選択の値を置き換えることができるようにしたいと思います。たとえば、入力 "rep1_C0"を "Control_rep1"に変更します。それから問題の反応性ベクトルを更新します。ここに私のコードです：

library(shiny) 

ui <- shinyUI(fluidPage(


    sidebarLayout(
     sidebarPanel(
     fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)), 
       column(5, numericInput("reps","# Replicates",value = 1,min = 1)) 
     ), 
     uiOutput("selectnames") 
    ), 

     mainPanel(
     tableOutput("testcols") 
    ) 
    ) 
)) 

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



    standardNames <- reactive({ 
     paste("rep",rep(1:input$reps,each = input$chans),"_", 
          rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "") 
    }) 

    output$selectnames <- renderUI({ 
     selectizeInput("selectnames", "Change Names", choices = standardNames(), 
         options = list(maxOptions = input$reps * input$chans)) 
}) 

    ## output 

    output$testcols <- renderTable({ 
     standardNames() 
    }) 

}) 

shinyApp(ui = ui, server = server) 

私はこれを可能にするオプションのセクションで渡すことができるいくつかの種類のオプションがありますか？

Answer 1

selectizeInputを使用すると、選択リストにレベルを追加できるようにoptions = list(create = TRUE)を設定できますが、それはあなたが望むものではないと思います。

代わりに、各標準名のテキスト入力ボックスを生成し、ユーザーがラベルを入力できるようにするコードを次に示します。 lapplyとsapplyを使用して各値をループし、入力を生成/読み込みます。

library(shiny) 

ui <- shinyUI(fluidPage(


    sidebarLayout(
    sidebarPanel(
     fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)), 
       column(5, numericInput("reps","# Replicates",value = 1,min = 1)) 
    ), 
     uiOutput("setNames") 
    ), 

    mainPanel(
     tableOutput("testcols") 
    ) 
) 
)) 

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



    standardNames <- reactive({ 
    paste("rep",rep(1:input$reps,each = input$chans),"_", 
      rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "") 
    }) 

    output$setNames <- renderUI({ 

    lapply(standardNames(), function(thisName){ 
     textInput(paste0("stdName_", thisName) 
       , thisName 
       , thisName) 
    }) 

    }) 

    labelNames <- reactive({ 
    sapply(standardNames() 
      , function(thisName){ 
      input[[paste0("stdName_", thisName)]] 
      }) 
    }) 

    ## output 

    output$testcols <- renderTable({ 
    data.frame(
     stdName = standardNames() 
     , label = labelNames() 
    ) 
    }) 

}) 

shinyApp(ui = ui, server = server) 

ユーザーがラベルを追加したい場合を除き、リストを非表示にしたい場合は、使用は、それを表示するボックスをチェックするまでのラベルを作るリストを隠し、このような単純なチェックボックスを、使用することができます。

library(shiny) 

ui <- shinyUI(fluidPage(


    sidebarLayout(
    sidebarPanel(
     fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)), 
       column(5, numericInput("reps","# Replicates",value = 1,min = 1)) 
    ) 
     , uiOutput("setNames") 
    ), 

    mainPanel(
     tableOutput("testcols") 
    ) 
) 
)) 

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

    vals <- reactiveValues(
    labelNames = character() 
) 


    standardNames <- reactive({ 
    out <- paste("rep",rep(1:input$reps,each = input$chans),"_", 
       rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "") 
    vals$labelNames = setNames(out, out) 

    return(out) 
    }) 

    output$setNames <- renderUI({ 

    list(
     h4("Add labels") 
     , selectInput("nameToChange", "Standard name to label" 
        , names(vals$labelNames)) 
     , textInput("labelToAdd", "Label to apply") 
     , actionButton("makeLabel", "Set label") 
    ) 

    }) 

    observeEvent(input$makeLabel, { 
    vals$labelNames[input$nameToChange] <- input$labelToAdd 
    }) 

    ## output 

    output$testcols <- renderTable({ 
    data.frame(
     stdName = standardNames() 
     , label = vals$labelNames 
    ) 
    }) 

}) 

shinyApp(ui = ui, server = server) 

：ユーザーが1つまたはラベルの小さな数を変更したいかもしれないと思う場合

library(shiny) 

ui <- shinyUI(fluidPage(


    sidebarLayout(
    sidebarPanel(
     fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)), 
       column(5, numericInput("reps","# Replicates",value = 1,min = 1)) 
    ) 
     , checkboxInput("customNames", "Customize names?") 
     , uiOutput("setNames") 
    ), 

    mainPanel(
     tableOutput("testcols") 
    ) 
) 
)) 

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



    standardNames <- reactive({ 
    paste("rep",rep(1:input$reps,each = input$chans),"_", 
      rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "") 
    }) 

    output$setNames <- renderUI({ 

    if(!input$customNames){ 
     return(NULL) 
    } 

    lapply(standardNames(), function(thisName){ 
     textInput(paste0("stdName_", thisName) 
       , thisName 
       , thisName) 
    }) 

    }) 

    labelNames <- reactive({ 

    if(!input$customNames){ 
     return(standardNames()) 
    } 

    sapply(standardNames() 
      , function(thisName){ 
      input[[paste0("stdName_", thisName)]] 
      }) 
    }) 

    ## output 

    output$testcols <- renderTable({ 
    data.frame(
     stdName = standardNames() 
     , label = labelNames() 
    ) 
    }) 

}) 

shinyApp(ui = ui, server = server) 

また、ここで彼らがにラベルを適用している標準のどの名前を選択できるようにする方法があります