आर में dplyr लाइब्रेरी से डेटासेट starwars का उपयोग करते हुए RShiny ऐप का एक उदाहरण यहां दिया गया है। यह एक पिवट टेबल तैयार करता है जहां एक एंड-यूज़र कई 'आयामों', 'माप' का चयन करने में सक्षम होगा। (एस)', और 'एग्रीगेट फंक्शन' वे चाहते हैं और यह तदनुसार एक परिणामी डेटासेट तैयार करता है।

हालांकि, जब मैं RShiny ऐप का परीक्षण कर रहा हूं, तो 'एग्रीगेट फंक्शन' ठीक से काम नहीं कर रहा है। समस्या वहां होनी चाहिए जहां pivotData डेटाफ्रेम परिभाषित किया गया हो। summarize_at dplyr श्रृंखला में, वस्तु funsList को उसके पिछले असाइनमेंट input$funChoices से बाहर कर दिया जाता है। हालांकि यह काम नहीं करता है और उत्पादन और त्रुटि करता है।

नीचे कोड:

pivotData <- reactive({
    input$runit
    isolate({
      measuresVec <- input$measures
      dimensionsVec <- input$dimensions
      funsList <- input$funChoices
      
      pivotData <- data %>%
        group_by_at(vars(dimensionsVec)) %>%
        summarize_at(vars(measuresVec), funsList , na.rm = TRUE)
    })
    
    return(pivotData)
    
  })

यदि आप शुरुआत में परिभाषित funsList को functions ऑब्जेक्ट से प्रतिस्थापित करते हैं, तो आप देखेंगे कि पहले दो इनपुट (आयाम और माप) काम करते हैं। हालांकि, कार्यों की संख्या स्पष्ट रूप से RShiny ऐप में पूर्वनिर्धारित है और अंत-उपयोगकर्ता को वह अवसर प्राप्त किए बिना स्वचालित रूप से प्रदर्शित किया जाएगा।

आदर्श रूप से, स्तंभों की कुल संख्या बराबर होनी चाहिए (# आयामों का) + (# उपायों का * # कार्यों का)

किसी भी तरह की सहायता का स्वागत किया जाएगा! बहुत बहुत धन्यवाद!

नीचे संपूर्ण कोड स्निपेट:

library(DT)
library(shiny)
library(shinydashboard)
library(dplyr)
library(dbplyr)
library(tidyverse)
library(DBI)

ui <- function(request) {
  dashboardPage(
    dashboardHeader(title = "SW Pivot"),
    dashboardSidebar(
      actionButton("runit", "RUN QUERY"),
      hr(),
      
      h4(HTML("&nbsp"), "Select Table Rows"),
      uiOutput('rowSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Columns"),
      uiOutput('colSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Cell Fill"),
      uiOutput('aggSelect'),
      hr()
      
    ),
    dashboardBody(dataTableOutput("data"))
    
  )
}

data <- starwars

server<-shinyServer(function(input, output, session) {
  
  # Identify Measures, Dimensions, and Functions --------------
  
  dimensions <- colnames(data)[!sapply(data, is.numeric)]
  measures <- colnames(data)[sapply(data, is.numeric)]
  functions <- list( mean = mean, 
                     sum = sum, 
                     max = max, 
                     min = min)
  
  # functions <- as.vector(unlist(functions))
  
  output$rowSelect <- renderUI({
    selectizeInput(
      inputId = "dimensions",
      label = NULL,
      multiple = TRUE,
      choices = dimensions,
      selected = c()
    )
  })
  
  output$colSelect <- renderUI({
    selectizeInput(
      inputId = "measures",
      label = NULL,
      multiple = TRUE,
      choices = measures,
      selected = c()
    )
  })
  
  output$aggSelect <- renderUI({
    selectizeInput(
      inputId = "funChoices",
      label = NULL,
      multiple = TRUE,
      choices = functions,
      selected = c()
    )
  })
  
  pivotData <- reactive({
    input$runit
    isolate({
      measuresVec <- input$measures
      dimensionsVec <- input$dimensions
      funsList <- input$funChoices
      
      pivotData <- data %>%
        group_by_at(vars(dimensionsVec)) %>%
        summarize_at(vars(measuresVec), functions, na.rm = TRUE)
    })
    
    return(pivotData)
    
  })
  
  output$data <- renderDataTable({
      tabledata <- pivotData()
      datatable(tabledata)
  })
  
})

shinyApp(ui, server)
0
puj831 4 नवम्बर 2020, 22:54

1 उत्तर

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

जब आप function सूची को परिभाषित करते हैं तो फ़ंक्शन ठीक से संग्रहीत नहीं होते हैं। फ़ंक्शन का स्ट्रिंग नाम चुनना और बाद में वास्तविक फ़ंक्शन प्राप्त करने के लिए match.fun का उपयोग करना आसान है।

कुछ चीज़ें जो मैंने देखी हैं:

  • मैंने आपके dplyr कोड को across के साथ 1.0.0 में अपडेट कर दिया है
  • जब आप renderUI का उपयोग नहीं करते हैं, लेकिन कुछ चर बदलते हैं तो observeEvent/updateXInput का उपयोग करने पर आपको एक तेज़ UI मिलता है
library(DT)
library(shiny)
library(shinydashboard)
library(dplyr)

ui <- function(request) {
  dashboardPage(
    dashboardHeader(title = "SW Pivot"),
    dashboardSidebar(
      actionButton("runit", "RUN QUERY"),
      hr(),
      
      h4(HTML("&nbsp"), "Select Table Rows"),
      uiOutput('rowSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Columns"),
      uiOutput('colSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Cell Fill"),
      uiOutput('aggSelect'),
      hr()
      
    ),
    dashboardBody(dataTableOutput("data"))
    
  )
}

data <- starwars

server<-shinyServer(function(input, output, session) {
  
  # Identify Measures, Dimensions, and Functions --------------
  
  dimensions <- colnames(data)[!sapply(data, is.numeric)]
  measures <- colnames(data)[sapply(data, is.numeric)]
  functions_string <- c("mean", "sum", "max", "min")
  
  # functions <- as.vector(unlist(functions))
  
  output$rowSelect <- renderUI({
    selectizeInput(
      inputId = "dimensions",
      label = NULL,
      multiple = TRUE,
      choices = dimensions,
      selected = c()
    )
  })
  
  output$colSelect <- renderUI({
    selectizeInput(
      inputId = "measures",
      label = NULL,
      multiple = TRUE,
      choices = measures,
      selected = c()
    )
  })
  
  output$aggSelect <- renderUI({
    selectizeInput(
      inputId = "funChoices",
      label = NULL,
      multiple = TRUE,
      choices = functions_string,
      selected = c()
    )
  })
  
  pivotData <- eventReactive(input$runit, {
    measuresVec <- input$measures
    dimensionsVec <- input$dimensions
    
    fun_list <- lapply(input$funChoices, match.fun)
    names(fun_list) <- input$funChoices
    pivotData <- data %>%
      group_by(across(all_of(dimensionsVec))) %>%
      summarize(across(all_of(measuresVec), fun_list, na.rm = TRUE))
    
    return(pivotData)
    
  })
  
  output$data <- renderDataTable({
    tabledata <- pivotData()
    datatable(tabledata)
  })
  
})

shinyApp(ui, server)
1
starja 5 नवम्बर 2020, 00:22