r तीसरी कॉलम के आधार पर इनपुट के दो कॉलम पर एक पंक्ति में कार्रवाई की गतिशील संख्या और कार्रवाई की व्यवस्था करें




user-interface dynamic (2)

मैं दो विभिन्न पाठ इनपुटों को मैप करने के लिए एक चमकदार ऐप का निर्माण कर रहा हूं। मैं स्ट्रिंग दूरी का उपयोग करते हुए मिलान करता हूं, लेकिन वे गलत हो सकते हैं इसलिए, मैं एक चमकीला ऐप विकसित करने की योजना बना रहा हूं जहां विषय विशेषज्ञ विशेषज्ञ मिलान के विशिष्ट डेटा को चुनने के लिए क्लिक और ड्रॉपडाउन का उपयोग कर सकते हैं।

अगर मैंने कई पंक्तियों को तय किया है, तो मैं नीचे की तरह कुछ हासिल कर सकता हूं: हालांकि, जब मुझे डेटा में पंक्तियों की संख्या नहीं पता, तो मैं आवश्यक रूप से आउटपुट प्राप्त करने के लिए उपयोगकर्ता इंटरफ़ेस को कैसे डिजाइन कर सकता हूं?

प्रयोक्ता ने आवश्यक मानचित्रण किया है। मैं बटन क्लिक करने के बाद कुछ कार्रवाई करना चाहता हूं। इसके अतिरिक्त, अगर उपयोगकर्ता मैप किए गए क्लिक (चेक बॉक्स)। मैं अंतिम पंक्ति से उस पंक्ति को छोड़ना चाहता हूं

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)

आप चमकदार मॉड्यूल और 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 1-correct , 1-original , 1-options प्रथम मॉड्यूल, 2-correct , 2-original आदि के लिए विकल्प होगा ...

यह महत्वपूर्ण है क्योंकि आप इनपुट [[NAME_OF_THE_ELEMENT]] का उपयोग करके इनपुट तत्वों तक पहुंच सकते हैं

इसलिए उदाहरण के लिए मैं lapply चाहता हूँ कि input$original == input$options प्रत्येक मॉड्यूल के लिए input$original == input$options (आपके कोड के समान, लेकिन यह सामान्य है, इसलिए यह किसी भी संख्या में मॉड्यूल के लिए काम करता है)

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)

 uiOutput("mappings")

जहां आपके पास अब इनपुट है और सर्वर में आप इस तरह से कुछ जगह है

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

तो आप इस तरह से कुछ कर सकते हैं मूल्यों को प्राप्त करने के लिए

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

अपना उदाहरण लेना, ऐसा कुछ ऐसा दिख सकता है

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)




shinyapps