जैसा कि नीचे दिखाया गया है, मेरे पास RShiny में एक डेटाटेबल है।

ID  num_express dene    trans   a_dd_s.1    a_de_s.2    a_dd_s.3    a_de_s.4    a_de_s.5    a_dd_s.6    a_dd_s.100
id1 6   .   -1  2   5   0   7   1   2   9
id2 3   .   -1  6   2   0   1   0   0   0
id3 7   .   -1  3   8   6   12  10  12  9
id4 7   .   -1  3   14  4   10  17  22  10
id5 4   .   -1  0   8   0   4   0   4   4

वास्तविक डेटा तालिका में> 1000 कॉलम हैं। दूसरे कॉलम में मान कॉलम की संख्या है>0 कॉलम में a_dd_s.1 से a_dd_s.100 और b_dd_s.1 से b_dd_s.100.....z_dd_s.1 से z_dd_s.100 तक। सीमांकक "_" से पहले का पहला अक्षर समूह के अनुरूप है। यहाँ a,b,c....z समूह हैं।

डेटाटेबल को नेविगेट/स्क्रॉल करने के लिए बड़ी संख्या में कॉलम उपयोगकर्ता के लिए लचीले नहीं हैं। इसलिए, मैं डेटा तालिका में केवल कॉलम 1-4 प्रदर्शित करना चाहता हूं। और कॉलम a_dd_s.1 से z_dd_s.100 में संख्यात्मक डेटा को समूह द्वारा रंगीन बारचार्ट/डॉटप्लॉट के रूप में दिखाएं जब दूसरे कॉलम में मान क्लिक किया जाता है या प्रत्येक पंक्ति में होवर किया जाता है।

क्या यह शाइनी में किया जा सकता है। अगर ऐसा है तो कोई मदद कर सकता है।

0
chas 3 नवम्बर 2020, 21:54

1 उत्तर

सबसे बढ़िया उत्तर

हम जिस पंक्ति आईडी में हैं उसे निकालने के लिए dataTable में कॉलबैक का उपयोग करके पहला "ऑनक्लिक" दृष्टिकोण यहां दिया गया है और फिर इस आईडी का उपयोग observeEvent स्टेटमेंट में filter डेटा और प्लॉट बनाने एक मोडल पेज के अंदर showModal(modalDialog()) के साथ।

अपडेट करें
ओपी की टिप्पणियों के मुताबिक अब मैं:

  1. प्लॉट में चर नाम और मान दिखाने वाले टूलटिप्स जोड़ने के लिए {ggiraph} का उपयोग किया जाता है

  2. जोड़े गए चर समूह (a:c) डेटा बिंदुओं को तदनुसार रंगने की अनुमति देते हैं

  3. css (modalDialog में size तर्क जोड़कर मोडल पेज को व्यापक बनाया गया है, लेकिन यहां "l" अभी भी काफी बड़ा नहीं है)।

  4. चर नाम दिखाने के लिए साजिश को बड़ा बना दिया, हालांकि, उन्हें दिखाना अभी भी बहुत गन्दा है (1000 से अधिक चर हैं) इसलिए मुझे लगता है कि बेहतर विकल्प केवल टूलटिप और समूह द्वारा रंग दिखाना है।

       library(shiny)
       library(DT)
       library(data.table)
       library(forcats)
       library(ggplot2)
       library(waiter)
       library(plotly)
    
    
       modalActionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
    
         value <- restoreInput(id = inputId, default = NULL)
         tags$button(id = inputId, type = "button", style = if (!is.null(width)) 
           paste0("width: ", validateCssUnit(width), ";"), type = "button", 
           class = "btn btn-default action-button", `data-dismiss` = "modal", `data-val` = value, 
           list(shiny:::validateIcon(icon), label), ...)
    
       }
    
       # more realistic toy data which mimics your actual data
       # we will transform it later
       dat <- tibble::tribble(
         ~ID,  ~num_express, ~dene,    ~trans,
         "id1", 6,   ".",   -1,
         "id2", 3,   ".",   -1,
         "id3", 7,   ".",   -1,
         "id4", 7,   ".",   -1,
         "id5", 4,   ".",   -1) %>%
         tidyr::expand_grid(group = letters[1:3],
                            no = 1:100) %>%
         dplyr::mutate(var_nm = paste0(group, "_dd_s.", no),
                       var_val = round(runif(1500, min = 0, max = 99), 0)) %>%
         tidyr::pivot_wider(.,
                            id_cols = c(ID, num_express, dene, trans),
                            names_from = var_nm,
                            values_from = var_val)
    
       dat <- as.data.table(dat)
       # data preparation no using {data.table} starts here
       # before starting the data preparation with your real data
       # save it as .csv and it read in at the start of the app with
       # `dat <- fread("yourdata.csv")` 
       dat_dt <- dat[, -c(2:4), with=FALSE]
       dat_dt <- melt(dat_dt,
                      id.vars = "ID",
                      variable.name = "col_nm",
                      value.name = "val")
       dat_dt[, c("group", "col_nm1", "col_nm2", "col_no") := tstrsplit(col_nm, "[\\._]")
              ][,
                ttip := paste0("var: ", col_nm, "<br>",
                               "value: ", val)
                ][,
                  col_nm := as.factor(col_nm)
                  ]
    
     shinyApp(
       ui = fluidPage(
         use_waiter(),
    
      # make modal page wider
         tags$head(
           tags$style(HTML("
    
        .modal-dialog {
           width: 80%;
        }
      "))
         ),
    
         DT::dataTableOutput('table')
    
       ), # close FluidPage
    
    
       server = function(input, output, session) {
    
         w <- Waiter$new(id = "plot",
                         html = spin_whirly(),
                         color = "#FFFFFF")
    
         output$table <- DT::renderDataTable({
           datatable(dat[, .(ID, num_express, dene, trans)],
                     rownames = FALSE,
                     selection = 'none',
                     # get ID of clicked row
                     callback = JS(
                       'table.on("click.dt","tr", function() {
                 var data=table.row(this).data();
                 Shiny.onInputChange("rows",data[0]);
                  });')
           )
           })
    
         data_row <- reactive({
    
           dat_dt[ID == input$rows & val != 0,]
    
         })
    
         flag <- reactiveValues(val = 0)
    
         observeEvent(input$close, {
    
           flag$val <- flag$val - 1
    
         })
    
         observeEvent(input$rows, {
    
           flag$val <- flag$val + 1
    
         })
    
         temp_plot <- reactive({
    
           w$show()
    
           if (flag$val == 0) {
    
             p <- plotly_empty() %>% config(displayModeBar = FALSE,
                                       displaylogo = FALSE)
    
           } else {
    
           p <- ggplot(data_row(),
                       aes(x = fct_reorder(col_nm, val, min, .desc = TRUE),
                           y = val,
                           fill = group
                       )) +
             geom_col(position = "dodge") +
             scale_y_continuous(expand = c(0,0)) +
             theme(axis.text.x = element_blank(),
                   axis.ticks.x = element_blank())
    
           p <- ggplotly(p)
    
           }
    
           w$hide()
    
           p
    
         })
    
         output$plot <- renderPlotly({
    
           print(flag$val)
    
           temp_plot()
    
         })
    
         observeEvent(input$rows, {
           showModal(modalDialog(
             title = paste("Plot:", input$rows),
             plotlyOutput("plot",
                          width = "100%"),
             size = "l",
             easyClose = FALSE,
             footer = modalActionButton("close",
                                        "Close")
           ))
         })
    
    
       }
     )
    
0
TimTeaFan 12 नवम्बर 2020, 16:15