Rhandsontable की चयनित पंक्तियाँ प्राप्त करें




shiny (2)

मैं एक चमकदार ऐप में रैंडान्सेट योग्य का उपयोग कर रहा हूं और मैं इस मामले में हेन्डसेंटेबल की getSelected () पद्धति का उपयोग कैसे करना चाहूंगा, क्योंकि मैं data.frame पर परिवर्तन लागू करने का इरादा रखता हूं। धन्यवाद!


आप selectCallback = TRUE का उपयोग करके चयनित पंक्ति, कॉलम, श्रेणी और सेल मूल्यों के साथ-साथ संपादित सेल भी प्राप्त कर सकते हैं। आप उस पर डबल-क्लिक करके किसी कक्ष को संपादित कर सकते हैं, और "वापसी" या "दर्ज करें" दबाकर परिवर्तन स्वीकार कर सकते हैं।

न्यूनतम उदाहरण:

library(shiny)
library(rhandsontable)
ui=fluidPage(
  rHandsontableOutput('table'),
  verbatimTextOutput('selected')
)

server=function(input,output,session)({
  df=data.frame(N=c(1:10),L=LETTERS[1:10],M=LETTERS[11:20])
  output$table=renderRHandsontable(
    rhandsontable(df,selectCallback = TRUE,readOnly = FALSE)
  )
  output$selected=renderPrint({
    cat('Selected Row:',input$table_select$select$r)
    cat('\nSelected Column:',input$table_select$select$c)
    cat('\nSelected Cell Value:',
        input$table_select$data[[
          input$table_select$select$r]][[input$table_select$select$c]])
    cat('\nSelected Range: R',input$table_select$select$r,
        'C',input$table_select$select$c,':R',input$table_select$select$r2,
        'C',input$table_select$select$c2,sep="")
    cat('\nChanged Cell Row Column:',input$table$changes$changes[[1]][[1]],
        input$table$changes$changes[[1]][[2]])    
    cat('\nChanged Cell Old Value:',input$table$changes$changes[[1]][[3]])
    cat('\nChanged Cell New Value:',input$table$changes$changes[[1]][[4]])
  })
}) # end server
shinyApp(ui = ui, server = server)

जबकि रैंडान्सेट योग्य हैंडसेट योग्य का एक वास्तविक अच्छा कार्यान्वयन है (क्रेडिट को @ ज़ोवेन पर जाना जाता है), वर्तमान में इसमें getSelected () शामिल नहीं है

किसी उपयोगकर्ता को किसी भी सेल को बदलने (एक चेकबॉक्स को चुनने / अचयनित करने सहित) की घटना चमकदार है। यह चेकबॉक्स का उपयोग करने का अवसर देता है ताकि उपयोगकर्ता को एक या एक से अधिक पंक्तियों को चुनने दें (या चयन न करें)

दुर्भाग्य से यह समझने के लिए तर्क क्या चुना गया है कि आपके कोड द्वारा सर्वर साइड पर विकसित किए जाने की आवश्यकता है।

नीचे दिए गए कोड का स्निपेट आपको इसे प्रबंधित करने के बारे में कुछ विचार दे सकता है।

options(warn=-1)
library(rhandsontable)
library(shiny)

options(warn=-1)
quantity <- id <- 1:20
label <- paste0("lab","-",quantity)
pick <- FALSE
iris_ <- data.frame(id=id,pick=pick, quantity=quantity,label=label,iris[1:20,] ,stringsAsFactors = FALSE)
mtcars_ <- data.frame(id=id,pick=pick, quantity=quantity,label=label,mtcars[1:20,] ,stringsAsFactors = FALSE)
iris_$Species <- NULL #  i.e.  no factors
#---------------------------
ui <- fluidPage(
    fluidRow(
        column(6,rHandsontableOutput('demTb')),
        column(3,uiOutput("demSli")),
    column(3, radioButtons("inButtn", label=NULL, choices= c("iris","mtcars"), selected = "iris", inline = TRUE))
        )
    )

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

selData <- ""


output$demSli <- renderUI({

if(is.null(input$demTb) ) return()

isolate({
df_ <- hot_to_r(input$demTb)
index <- which(df_$pick==T)
if(length(index)==0) return()
labs <- iris_$label[index] 
pages <- "test"
iter <- length(labs)
buttn <- 1
valLabs <- sapply(1:iter, function(i) {
if(is.null(input[[paste0(pages,"d",labs[i],buttn)]] )) {
          0
} else {  as.numeric(input[[paste0(pages,"d",labs[i],buttn)]])  }
}) 
#
toRender <- lapply(1:iter, function(i) {
  sliderInput(inputId = paste0(pages,"d",labs[i],buttn),
              label =  h6(paste0(labs[i],"")),
              min = -100,
              max = 100,
              step = 1,
              value = valLabs[i],
              post="%",
              ticks = FALSE, animate = FALSE)
              })
})
      return(toRender)

})
#--------------------
rds <- reactive({

  # if( is.null(input$demTb) ) {
  if( input$inButtn == "iris") { 
      if(selData == "" | selData == "mtcars") {
         selData <<- "iris"

        return(iris_) # first time for iris
      }
  } else {
      if(selData == "iris" ) {
         selData <<- "mtcars"

        return(mtcars_) # first time for mtcars
      }
    }

df_ <- hot_to_r(input$demTb)
isolate({

index <- which(df_$pick==T) 
if(length(index)==0) return(df_)
labs <- iris_$label[index] 
pages <- "test"
iter <- length(labs)
buttn <- 1
}) # end isolate
valLabs <- sapply(1:iter, function(i) {
    if(is.null(input[[paste0(pages,"d",labs[i],buttn)]] )) {
      0
    } else {  
      as.numeric(input[[paste0(pages,"d",labs[i],buttn)]])/100  
    }
  })

  dft_ <- data.frame(label=labs, multi=valLabs, stringsAsFactors = FALSE)
  dft_ <- merge(iris_,dft_,by="label", all.x=T)

  dft_$quantity <- sapply(1:length(dft_$quantity), function(z) {
    if( is.na( dft_$multi[z]) ) { 
    dft_$quantity[z]
  } else { iris_$quantity[z]*(1 + dft_$multi[z]) }
})
dft_[with(dft_,order(as.numeric(id))),]
df_[with(df_,order(as.numeric(id))),]

df_$quantity <- df_$quantity
  return(df_)
  }) 


output$demTb  <-  renderRHandsontable({


if(is.null(rds() )) return()

df_ <- rds() 

df_ <- df_[with(df_,order(as.numeric(id))),]

rhandsontable(df_, readOnly = FALSE, rowHeaders= NULL, useTypes= TRUE) %>%
  hot_table(highlightCol = TRUE, highlightRow = TRUE) 


})

}


shinyApp(ui, server)




handsontable