Как загрузить исходные данные, использованные для генерации выбранных строк в R блестящий - PullRequest
Новая
       11

Как загрузить исходные данные, использованные для генерации выбранных строк в R блестящий

0 голосов
/ 20 сентября 2019

Я пытаюсь загрузить исходные данные (mpg), которые я использовал для генерации выбранных строк в таблице DT.В таблице приведены агрегированные результаты, основанные на группировке ввода из исходных данных.

Я попытался: сначала получить номер строки с помощью функции _rows_selected, затем собрать список значений в столбце группировщика, затем определить индексы строк этого значения в исходных данных, а затем записать экспортированныйCSV на основе этих индексов строк и исходных данных.

Но, похоже, это не сработало, и я не мог понять, почему.


library(datasets)
library(shiny)
library(dplyr)
library(plotly)
library(ggplot2)
library(DT)
library(crosstalk)

data("mpg")
mpg = data.frame(mpg)
#convert all column input from character to factor (or assure they are all factor)
for(i in 1:dim(mpg)[2]){
  mpg[,i] = type.convert(mpg[,i])
  i = i+1
}

#mpg$manufacturer = type.convert(mpg$manufacturer)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Analyze MPG table"),

  # Sidebar with a dropdown menu selection input for key meausre component
  sidebarLayout(
    sidebarPanel(
      selectInput("yInput", "Measuring element: ", 
                  colnames(mpg), selected = colnames(mpg)[9]), 
      selectInput('xInput', 'Grouper: ', 
                  colnames(mpg), selected = colnames(mpg)[1]), 
      selectInput('xInput2', 'Filter Column: ', 
                  colnames(mpg), selected = colnames(mpg)[2]),
      p(downloadButton('x0', 'Download Source Data of Selected Rows', 
                       class = 'text-center'))
    ),

    # Show a plot of the generated distribution
    mainPanel(
      uiOutput('filter'),
      plotlyOutput("barPlot"),
      DTOutput('table1')

    )
  )
)



server <- function(input, output) {


  output$filter = renderUI({
    selectInput('inputF2', 'Filter Item: ', 
                c('No Filter', unique(mpg %>% select(input$xInput2))))
  })



  mpg_sub <- reactive({  
    if (req(input$inputF2) != 'No Filter') {
      mpg_sub <- mpg %>% filter_at(vars(input$xInput2), any_vars(. == input$inputF2))
    } else{
      mpg_sub <- mpg
    }
    return(mpg_sub)
  })



  by_xInput <- reactive({  
    mpg_sub() %>% 
      group_by_at(input$xInput) %>% 
      # n() can replace the length
      # convert string to symbol and evaluate (!!)
      summarize(n = n(), mean_y = mean(!! rlang::sym(input$yInput)))
  })



  output$table1 = renderDT(
    datatable(by_xInput(), 
              extensions = 'Buttons', 
              options = list(dom = 'Bfrtip',
                             buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))

              )
  )

  #####here is where I have the issue... 

  output$x0 = downloadHandler(
    'Source Data_selected.csv', 
    content = function(file){
      s0 = input$table1_rows_selected
      grouper = by_xInput()[s0, 1]
      big = mpg_sub()[, match(as.character(input$xInput), colnames(mpg_sub()))]
      position = which(!is.na(match(big, grouper)))

      write.csv(mpg_sub()[position, , drop = F], file)
    }
  )




}


shinyApp(ui = ui, server = server)

Ответы [ 2 ]

1 голос
/ 20 сентября 2019

ответ Бена работает с исходными данными mpg;если mpg отформатирован в data.frame, это будет работать.Комментарии Бена очень помогли мне придумать это решение !!


output$x0 = downloadHandler(
    'Source Data_selected.csv', 
    content = function(file){
      s0 = input$table1_rows_selected
      grouper = by_xInput()[s0, 1]

      big2 = mpg_sub() %>% pull(!!rlang::sym(input$xInput))
      position2 = which(!is.na(match(big2, grouper[[1]])))

      write.csv(mpg_sub()[position2 , , drop = F], file)
    }
  )
1 голос
/ 20 сентября 2019

Некоторые вещи кажутся необходимыми:

  1. Исправьте input$inputC1 до input$xInput, как в комментарии.
  2. big и grouper выглядят как тиблыне векторы.Измените оператор match, как показано ниже, чтобы получить один столбец как вектор из таблицы.
  3. position должны быть строками для абстрагирования от mpg_sub(), а не от столбцов.Поставьте position перед запятой.

Пожалуйста, дайте мне знать, если это работает. 

output$x0 = downloadHandler(
    'Source Data_selected.csv', 
    content = function(file){
      s0 = input$table1_rows_selected
      grouper = by_xInput()[s0, 1]
      big = mpg_sub()[, match(as.character(input$xInput), colnames(mpg_sub()))]
      position = which(!is.na(match(big[[1]], grouper[[1]])))
      write.csv(mpg_sub()[position , , drop = F], file)
    }
  )
...