3行目の入力の動的な数と3列目の入力の2つの列のアクション

Question

2つの異なるテキスト入力をマッピングする光沢のあるアプリケーションを構築しています。私は文字列の距離を使用して一致を行うが、それらは誤っている可能性があります。だから、私は主題の専門家がクリックとドロップダウンを使用して一意のデータにマッチするような光沢のあるアプリを開発するつもりです。

固定数の場合、以下のようにすることができます。ただし、データの行数がわからない場合は、どのように動的にユーザーインターフェイスを設計して必要な出力を得ることができますか？

ユーザーが必要なマッピングを実行した後。ボタンをクリックした後で何らかのアクションを実行したい。さらに、ユーザーがマップ済み（チェックボックス）をクリックした場合。私は最後の行為からその行を残したい。あなたは今の入力を持ち、サーバーにあなたは、あなたがこの

observe({ 
    lapply(
    1:length(someList), 
    function(idx){input[[paste0("correct",idx)]]} 
) 
}) 

ような何かを行うことができます値を取得するには、この

output$mappings <- renderUI({ 
    tagList(
    lapply(
     1:length(someList), 
     function(idx){ 
     fluidRow(# first row checkbox 
      column(width = 2, offset = 0, 
       checkboxInput(paste0("correct",idx), label = NULL, FALSE) 
     ), 
      column(width = 2, offset = 0, # text input originial 
       textInput(inputId = paste0("original",idx), value = let_small[1], label = NULL) 
     ), 
      column(width = 5, # options for match 
       selectInput(inputId = paste0("options",idx), label = NULL, 
          choices = let_caps, width = 500) 
     ) 
     ) 
     } 
    ) 
) 
}) 

のようなものを置く

library(shiny) 
set.seed(42) 
n_samp = 5 # this comes from the input 
indx <- sample(1:20, n_samp) 

let_small <- letters[indx] 
let_caps <- sample(LETTERS[indx]) 

# user input 
ui <- fluidPage(
    selectInput(inputId = "n_samp_choice", label = NULL, 
       choices = 1:20, width = 500), # number of samples 
    fluidRow(# first row checkbox 
    column(width = 2, offset = 0, 
      checkboxInput("correct1", label = NULL, FALSE) 
    ), 
    column(width = 2, offset = 0, # text input originial 
      textInput(inputId = "original1", value = let_small[1], label = NULL) 
    ), 
    column(width = 5, # options for match 
      selectInput(inputId = "options1", label = NULL, 
         choices = let_caps, width = 500) 
    ) 
), 
    fluidRow( 
    column(width = 2, offset = 0, 
      checkboxInput("correct1", label = NULL, FALSE) 
    ), 
    column(width = 2, offset = 0, 
      textInput(inputId = "original2", value = let_small[2], label = NULL) 
    ), 
    column(width = 5, 
      selectInput(inputId = "options2", label = NULL, 
         choices = let_caps, width = 500) 
    ) 
), 
    fluidRow(
    column(width = 2, offset = 0, 
      checkboxInput("correct1", label = NULL, FALSE) 
    ), 
    column(width = 2, offset = 0, 
      textInput(inputId = "original3", value = let_small[3], label = NULL) 
    ), 
    column(width = 5, 
      selectInput(inputId = "options3", label = NULL, 
         choices = let_caps, width = 500) 
    ) 
), 
    fluidRow(
    column(width = 2, offset = 0, 
      checkboxInput("correct1", label = NULL, FALSE) 
    ), 
    column(width = 2, offset = 0, 
      textInput(inputId = "original4", value = let_small[4], label = NULL) 
    ), 
    column(width = 5, 
      selectInput(inputId = "options4", label = NULL, 
         choices = let_caps, width = 500) 
    ) 
), 
    fluidRow(
    column(width = 2, offset = 0, 
      checkboxInput("correct1", label = NULL, FALSE) 
    ), 
    column(width = 2, offset = 0, 
      textInput(inputId = "original5", value = let_small[5], label = NULL) 
    ), 
    column(width = 5, 
      selectInput(inputId = "options5", label = NULL, 
         choices = let_caps, width = 500) 
    ), 
    column(width = 2, offset = 0, 
      uiOutput("actionBut.out") 
    ) 
) 
) 


server <- function(input, output, session) { 
    output$actionBut.out <- renderUI({ 
    print(input$original1) 
    session$sendCustomMessage(type="jsCode", 
           list(code= "$('#text').prop('disabled',true)")) 
    actionButton("copyButton1","Copy Code") 
    }) 

    observeEvent(input$copyButton1, { 

    if(tolower(input$options1) == tolower(input$options1) & 
     tolower(input$options2) == tolower(input$options2) & 
     tolower(input$options3) == tolower(input$options3) & 
     tolower(input$options4) == tolower(input$options4) & 
     tolower(input$options5) == tolower(input$options5)) 
    { 
     print("great job") 
    }else{ 
     unmapp <- which(c(input$correct1, input$correct2, 
         input$correct3, input$correct4, 
         input$correct5)) 
     print("The following are unmatched") 
     print(let_caps[unmapp]) 
    } 
    }) 

} 

shinyApp(ui = ui, server = server) 

Answer 1

Shiny ModulesとUIOutputを使用して動的デザインを作成できます。

ステップ1は：ループによって呼び出されるモジュールを作成：

moduleUI <- function(id) { 
    ns <- NS(id) 

    tagList(
    fluidRow(# first row checkbox 
     column(width = 2, offset = 0, 
      checkboxInput(ns("correct"), label = NULL, FALSE) 
    ), 
     column(width = 2, offset = 0, # text input originial 
      textInput(inputId = ns("original"), value = let_small[id], label = NULL) 
    ), 
     column(width = 5, # options for match 
      selectInput(inputId = ns("options"), label = NULL, 
         choices = let_caps, width = 500) 
    ) 
    ) 
) 
} 

ステップ2：モジュールのプレースホルダとして機能するUIOutputを作成。

uiOutput("module_placeholder") 

ステップ3：サーバー・ロジックを追加します。

私はあなたが異なる数の行をシミュレートすることができますnumericInputを追加しました。例：5に設定すると、モジュールが5回生成されます。

このobserverを使用すると、モジュールの任意の数のインスタンスを生成できます。オブジェクトの

observe({ 
    output$module_placeholder <- renderUI({ 
     lapply(1:input$num, moduleUI) 
    }) 
    }) 

id sが、第二のモジュールのためなど1-correct、1-original、最初のモジュールのための1-options、2-correct、2-original、となります...

あなたがアクセスできるため、これは重要です入力[[NAME_OF_THE_ELEMENT]]を使用して要素を入力します。

したがって、たとえば、モジュールごとにinput$original == input$optionsがあるかどうかを確認するには、lapplyを使用します。（あなたのコードに似ていますが、それは任意の数のモジュールのために動作しますので、それは、一般的です）

cond <- unlist(lapply(to_check, function(x) { 
    tolower(input[[paste(x, "original", sep="-")]]) == tolower(input[[paste(x, "options", sep="-")]]) 
})) 

完全なコード参照してください：

library(shiny) 
set.seed(42) 
n_samp = 10 # this comes from the input 
indx <- sample(1:20, n_samp) 

let_small <- letters[indx] 
let_caps <- sample(LETTERS[indx]) 


moduleUI <- function(id) { 
    ns <- NS(id) 

    tagList(
    fluidRow(# first row checkbox 
     column(width = 2, offset = 0, 
      checkboxInput(ns("correct"), label = NULL, FALSE) 
    ), 
     column(width = 2, offset = 0, # text input originial 
      textInput(inputId = ns("original"), value = let_small[id], label = NULL) 
    ), 
     column(width = 5, # options for match 
      selectInput(inputId = ns("options"), label = NULL, 
         choices = let_caps, width = 500) 
    ) 
    ) 
) 
} 

ui <- fluidPage(
    numericInput(inputId = "num", label = "Select number of modules", value = 1, min = 1), 
    selectInput(inputId = "n_samp_choice", label = NULL, 
       choices = 1:20, width = 500), # number of samples 
    uiOutput("module_placeholder"), 
    uiOutput("actionBut.out") 
) 


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

    observe({ 
    output$module_placeholder <- renderUI({ 
     lapply(1:input$num, moduleUI) 
    }) 
    }) 

    output$actionBut.out <- renderUI({ 
    print(input$original1) 
    session$sendCustomMessage(type="jsCode", 
           list(code= "$('#text').prop('disabled',true)")) 
    actionButton("copyButton","Copy Code") 
    }) 

    observeEvent(input$copyButton, { 
    checked <- unlist(lapply(1:input$num, function(x) { 
     if(input[[paste(x, "correct", sep="-")]]) x 
    })) 

    if(length(checked) == 0) { 
     to_check <- 1:input$num 
    } else { 
     to_check <- (1:input$num)[-checked] 
    } 

    cond <- unlist(lapply(to_check, function(x) { 
     tolower(input[[paste(x, "original", sep="-")]]) == tolower(input[[paste(x, "options", sep="-")]]) 
    })) 

    if(all(cond)) { 
     print("great job") 
    } else { 
     unmapp <- which(!cond) 
     optns <- unlist(lapply(1:input$num, function(x) { 
     input[[paste(x, "options", sep="-")]] 
     })) 
     print("The following are unmatched") 
     print(optns[to_check][unmapp]) 
    } 
    }) 
} 

shinyApp(ui = ui, server = server) 

を

Answer 2

uiOutput("mappings") 

あなたの例を挙げると、このように見えるかもしれません。

library(shiny) 
set.seed(42) 
n_samp = 5 # this comes from the input 
indx <- sample(1:20, n_samp) 

let_small <- letters[indx] 
let_caps <- sample(LETTERS[indx]) 

# user input 
ui <- fluidPage(
    selectInput(inputId = "n_samp_choice", label = NULL, 
       choices = 1:20, width = 500), # number of samples 
    uiOutput("mappings"), 

) 


server <- function(input, output, session) { 
    output$actionBut.out <- renderUI({ 
    print(input$original1) 
    session$sendCustomMessage(type="jsCode", 
           list(code= "$('#text').prop('disabled',true)")) 
    actionButton("copyButton1","Copy Code") 
    }) 
    output$mappings <- renderUI({ 
    tagList(
     lapply(
     1:5, 
     function(idx){ 
      fluidRow(# first row checkbox 
      column(width = 2, offset = 0, 
        checkboxInput(paste0("correct",idx), label = NULL, FALSE) 
      ), 
      column(width = 2, offset = 0, # text input originial 
        textInput(inputId = paste0("original",idx), value = let_small[idx], label = NULL) 
      ), 
      column(width = 5, # options for match 
        selectInput(inputId = paste0("options",idx), label = NULL, 
           choices = let_caps, width = 500) 
      ) 
     ) 
     } 
    ) 
    ) 
    }) 

    lapply(
    1:5, 
    function(idx){ 
     observeEvent(input[[paste0("options",idx)]], 
        { 
        print(input[[paste0("options",idx)]]) 
        }, 
        ignoreInit = TRUE) 
    } 
) 
    observeEvent(input$copyButton1, { 

    if(tolower(input$options1) == tolower(input$options1) & 
     tolower(input$options2) == tolower(input$options2) & 
     tolower(input$options3) == tolower(input$options3) & 
     tolower(input$options4) == tolower(input$options4) & 
     tolower(input$options5) == tolower(input$options5)) 
    { 
     print("great job") 
    }else{ 
     unmapp <- which(c(input$correct1, input$correct2, 
         input$correct3, input$correct4, 
         input$correct5)) 
     print("The following are unmatched") 
     print(let_caps[unmapp]) 
    } 
    }) 

} 

shinyApp(ui = ui, server = server)