tipos - verbos en ingles

Organice 3 números dinámicos de entradas en una fila y acción en dos columnas de entradas basadas en la tercera columna

Question

Estoy construyendo una aplicación brillante para mapear dos entradas de texto diferentes. Hago el emparejamiento usando distancias de cuerda, pero pueden ser erróneas. Por lo tanto, estoy planeando desarrollar una aplicación brillante donde los expertos en la materia pueden usar el clic y el menú desplegable para seleccionar coincidencias con datos únicos.

Si he arreglado el número de filas, puedo lograr algo como a continuación :: Sin embargo, cuando no sé la cantidad de filas en los datos, ¿cómo puedo diseñar dinámicamente la interfaz del usuario para obtener el resultado requerido?

Después de que el usuario haya realizado la asignación requerida. Quiero realizar alguna acción después de hacer clic en el botón. Además, si el usuario ha hecho clic en mapeado (la casilla de verificación). Quiero dejar esa fila fuera de la acción final.

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

Puede crear un diseño dinámico usando Shiny Modules y UIOutput .

Paso 1 : crea un módulo para ser llamado por un bucle:

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)
      )
    )
  )
}

Paso 2 : UIOutput un UIOutput , que servirá como un marcador de posición para el módulo.

uiOutput("module_placeholder")

Paso 3 : agregue la lógica del servidor:

numericInput una entrada numericInput que le permite simular diferentes números de filas. Por ejemplo: si lo configura en 5, el módulo se generará 5 veces.

Este observer permite generar cualquier cantidad de instancias del módulo.

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

Los id de los objetos serán 1-correct , 1-original , 1-options para el primer módulo, 2-correct , 2-original , etc. para el segundo módulo, ...

Es importante porque puede acceder a los elementos de entrada usando la entrada [[NAME_OF_THE_ELEMENT]].

Entonces, por ejemplo, utilizo lapply para verificar si input$original == input$options para cada módulo. (Similar a su código, pero es general, por lo que funciona para cualquier cantidad de módulos)

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

Ver el código completo :

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")

donde tienes las entradas ahora y en el servidor colocas algo como esto

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)
          )
        )
      }
    )
  )
})

para obtener los valores, puedes hacer algo como esto

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

tomando su ejemplo, podría verse algo como esto

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)