Nano Hash - криптовалюты, майнинг, программирование

позволить пользователю создавать различные действия кнопок в приложении shinydashboard

Я хочу создать блестящее приложение, которое позволяет пользователю выбирать несколько столбцов для фильтрации data.table.

Мои реальные данные имеют ~ 110 столбцов, а столбцы numeric, character, factor, integer

Я хочу иметь предварительно выбранный фильтр на боковой панели, а также иметь кнопку +, позволяющую пользователю создавать собственные фильтры на основе столбцов. Я не знаю, можно ли это сделать блестящим или нет, я читал о insertUI и removeUI, но я не знаю, можно ли это применить к этому случаю. Кроме того, фильтры, созданные пользователем, должны применяться последовательно, т. Е. Если пользователь создает три фильтра, следует применять фильтр 1, затем фильтр 2 и затем фильтр 3.

У меня есть этот небольшой пример приложения, в котором есть начальный фильтр на основе Person с использованием textAreaInput (мой последний пользователь хотел бы вставить несколько имен в поле, чтобы отфильтровать таблицу), но я хотел бы добавить еще несколько фильтров, например sliderInput для votes или раскрывающееся меню для letters.

library(shinydashboard)
library(dplyr)
library(shiny)
library(DT)

header <- dashboardHeader(title="Analysis and database")

sidebar <- dashboardSidebar(
  sidebarMenu(
   # Setting id makes input$tabs give the tabName of currently-selected tab
    id = "sidebarmenu",
    menuItem("Database", tabName="db"),
    menuItem("Search by Name", tabName = "Filt_table"),
      textAreaInput("name_", "Name")
 )
)

body <- dashboardBody(

 tabItems(
  tabItem("db","table content",
        fluidRow(DT::dataTableOutput('tabla'))),
  tabItem("Filt_table","Filtered table content",
        fluidRow(DT::dataTableOutput('tablafilt')))
 )
)

ui <- dashboardPage(header, sidebar, body)

### SERVER SIDE

server = function(input, output, session) {

my_data <- data.frame(Person=c("Anne", "Pete", "Rose", "Julian", "Tristan", "Hugh"), 
Votes=c(10,25,56,89.36,78,1500), 
Stuff=c("test|3457678", "exterm|4567sdf", "1001(hom);4.3.4|3456", "xdfrtg", "1234|trsef|456(het)", "hyggas|tertasga"),
 letters=replicate(6, paste(sample(LETTERS,6, replace=T), collapse="")))

output$tabla <- DT::renderDataTable({
  DT::datatable(my_data)
})

filtered <- reactive({
  if(is.null(input$name_))
    return()  
    glist <- isolate(input$name_)
    filter(my_data, Person %in% glist)
 })

output$tablafilt <- DT::renderDataTable({
  if(is.null(input$name_))
    return()  

   DT::datatable(filtered (), 
              filter = 'top', 
              extensions = 'Buttons',
              options = list(
                dom = 'Blftip',
                buttons = 
                  list('colvis', list(
                    extend = 'collection',
                    buttons = list(list(extend='csv',
                                        filename = 'results'),
                                   list(extend='excel',
                                        filename = 'results'),
                                   list(extend='pdf',
                                        filename= 'results')),
                    text = 'Download'
                  )),
                scrollX = TRUE,
                pageLength = 5,
                lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
              ), rownames = FALSE
    )
  })



}
shinyApp(ui, server)
03.01.2019

  • просто чтобы убедиться. Я вижу, что вы используете аргумент filter = top (хотя в вашем примере его нет). Чем желаемая функциональность renderUI () будет отличаться от аргумента фильтра в таблице данных? См. 2.8 в rstudio.github.io/DT. 09.01.2019
  • @BigDataScientist, спасибо за комментарий, на самом деле мой желаемый renderUi () должен имитировать функциональность top. проблема в том, что в моей реальной таблице 140 столбцов, и пользователи не хотят прокручивать по горизонтали, чтобы применить фильтр, а иногда в DT с таким большим количеством столбцов прокрутка работает не очень хорошо, и данные не помещаются должным образом. Проблема также в том, что один пользователь хотел бы фильтровать по нескольким столбцам, а другой пользователь мог бы фильтровать по другим. Таким образом, идея состоит в том, чтобы позволить пользователю создавать фильтры (числовые, по коэффициенту и т. Д.) В соответствии с именами столбцов, кроме того, что texInputArea является обычным 09.01.2019
  • имеет смысл, спасибо за разъяснения! 09.01.2019
  • Это очень похоже на то, что я пытаюсь достичь, посмотрите здесь: stackoverflow.com/questions/54114153/ и связанном SO, у которого есть его рабочая версия 10.01.2019

Ответы:


1

Вы можете начать с создания selectInput() для всех переменных, а также с добавления и удаления кнопок:

  output$potentialFilter <- renderUI({
    tagList(
      selectInput("createFilter", "Create Filter", names(my_data)),
      actionButton("remove", "remove"),
      actionButton("add", "add")
    )
  })

А затем вы можете создать входные данные для выбранных переменных. Примечание. Поскольку вы не хотите сбрасывать вставленные пользовательские интерфейсы при добавлении новых, вам следует использовать insertUI() вместо renderUI().

  insertUI(selector = "#add", where = "afterEnd", 
           ui = selectizeInput(toBeIncluded, toBeIncluded, my_data[[toBeIncluded]], 
                               selected = my_data[[toBeIncluded]], multiple = TRUE)
  )

Полный пример будет выглядеть так:

  library(shinydashboard)
  library(dplyr)
  library(shiny)
  library(DT)

  header <- dashboardHeader(title="Analysis and database")

  sidebar <- dashboardSidebar(
    sidebarMenu(
      # Setting id makes input$tabs give the tabName of currently-selected tab
      id = "sidebarmenu",
      menuItem("Database", tabName="db"),
      menuItem("Search by Name", tabName = "Filt_table"),
      uiOutput("potentialFilter"),
      uiOutput("rendFilter")
    )
  )

  body <- dashboardBody(

    tabItems(
      tabItem("db","table content",
              fluidRow(DT::dataTableOutput('tabla'))),
      tabItem("Filt_table","Filtered table content",
              fluidRow(DT::dataTableOutput('tablafilt')))
    )
  )

  ui <- dashboardPage(header, sidebar, body)

  ### SERVER SIDE

  server = function(input, output, session) {

    my_data <- data.frame(Person=c("Anne", "Pete", "Rose", "Julian", "Tristan", "Hugh"), 
                          Votes=c(10,25,56,89.36,78,1500), 
                          Stuff=c("test|3457678", "exterm|4567sdf", "1001(hom);4.3.4|3456", "xdfrtg", "1234|trsef|456(het)", "hyggas|tertasga"),
                          letters=replicate(6, paste(sample(LETTERS,6, replace=T), collapse="")),
                          stringsAsFactors = FALSE)

    global <- reactiveValues(filter = c(), filteredData = my_data, tagList = tagList())

    output$potentialFilter <- renderUI({
      tagList(
        selectInput("createFilter", "Create Filter", names(my_data)),
        actionButton("remove", "remove"),
        actionButton("add", "add")
      )
    })


    observeEvent(input$add, {
      global$filter <- c(global$filter, input$createFilter)
      toBeIncluded <- input$createFilter
      data <- my_data[[toBeIncluded]]
      if(typeof(data) == "double"){
        ui <- numericInput(toBeIncluded, toBeIncluded, ceiling(min(data)), min = min(data), max = max(data))
      }else if(typeof(data) == "character"){
        ui <- textAreaInput(toBeIncluded, toBeIncluded, data[1], width = "200px")
      }
      insertUI(selector = "#add", where = "afterEnd", ui = ui)
    })

    observeEvent(input$remove, {  
      global$filter <- setdiff(global$filter, input$createFilter)
      removeUI(selector = paste0("div:has(> #", input$createFilter, ")"))
    })

    output$tabla <- DT::renderDataTable({
      DT::datatable(filtered())
    })

    filtered <- reactive({
      if(length(global$filter)){
        for(filterName in global$filter){
          if(is.character(input[[filterName]])){
            names <- unlist(strsplit(input[[filterName]], ";"))
            my_data <- my_data[my_data[[filterName]] %in% names, ]           
          }else if(is.numeric(input[[filterName]])){
            my_data <- my_data[my_data[[filterName]] >= input[[filterName]], ] 
          }
        }
      }
      return(my_data)
    })

    output$tablafilt <- DT::renderDataTable({
      DT::datatable(filtered(), 
                    filter = 'top', 
                    extensions = 'Buttons',
                    options = list(
                      dom = 'Blftip',
                      buttons = 
                        list('colvis', list(
                          extend = 'collection',
                          buttons = list(list(extend='csv',
                                              filename = 'results'),
                                         list(extend='excel',
                                              filename = 'results'),
                                         list(extend='pdf',
                                              filename= 'results')),
                          text = 'Download'
                        )),
                      scrollX = TRUE,
                      pageLength = 5,
                      lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
                    ), rownames = FALSE
      )
    })



  }
  shinyApp(ui, server)

(Я не уверен, что это имеет значение, в каком порядке вы применяете фильтр, возможно, вы сможете подробно рассказать об этом, если я ошибаюсь).

09.01.2019
  • Большое спасибо за ответ, но желаемое поведение будет заключаться в том, что фильтры применяются последовательно, то есть, если я применяю фильтр по Человеку, а затем фильтр по Голосам, только лица, выбранные с помощью фильтра Лица, будут отфильтрованы по голосованию. Теперь, если я щелкну два вновь созданных фильтра, первый будет сброшен и отобразится полная таблица. Кроме того, есть ли способ использовать другой вариант для selectizeInput, мои реальные данные содержат 20 000 строк и selectizeInput отображают все параметры. Если это слишком много вопросов, последовательного фильтра будет достаточно. Спасибо 10.01.2019
  • простите, я заболел. Возможно, я смогу взглянуть позже на этой неделе. 14.01.2019
  • @BigSataScientist Вы изменили свое мнение, чтобы еще раз взглянуть на этот вопрос? 18.01.2019
  • сегодня снова встал с постели;) Сделал обновление. Я не уверен в вашей selectizeInput спецификации. Вы бы заменили selectInput("createFilter", "Create Filter", names(my_data)) (вверху моего сообщения) вводом текста или как бы вы подошли к задаче 20k строк? 18.01.2019
  • надеюсь, вы лучше @BigDataScientist, selectInput может быть подмножеством столбцов, хотя в наборе данных более 100 столбцов, которые пользователь обычно хочет отфильтровать максимум по 5-10 20.01.2019
  • хорошо, если я правильно понимаю, этого можно достичь с помощью текущего кода. Есть ли ответы на ваши вопросы или есть открытые вопросы? 22.01.2019
  • да, теперь фильтр работает, но есть ли простой способ изменить фильтр на основе значения в таблице? То есть для числовых значений, вместо отображения всех значений (30K значений), это может быть ползунок и для символов просто textArea, где вы можете вводить и фильтровать те значения, которые вы вводите? Я думаю о своей большой таблице, когда ~ 30k значений при создании фильтра 22.01.2019
  • ах да, вот что я тоже задавался вопросом. Я сделал правку. Вы можете добавить несколько имен с помощью; (точка с запятой) как разделитель, .. 23.01.2019
  • Спасибо @BigDataScientist, он отлично работает, у меня есть небольшой вопрос, в textArea, если я хочу вводить имена по строкам вместо точки с запятой, мне нужно будет изменить эту строку правильно names <- unlist(strsplit(input[[filterName]], ";")) 23.01.2019

  • 2

    Вы всегда можете обновить свои фильтры на месте, используя

    updateSelectInput и другие

    https://shiny.rstudio.com/reference/shiny/0.13.2/updateSelectInput.html

    Лучший!

    21.01.2019
    Новые материалы

    Кластеризация: более глубокий взгляд
    Кластеризация — это метод обучения без учителя, в котором мы пытаемся найти группы в наборе данных на основе некоторых известных или неизвестных свойств, которые могут существовать. Независимо от..

    Как написать эффективное резюме
    Предложения по дизайну и макету, чтобы представить себя профессионально Вам не позвонили на собеседование после того, как вы несколько раз подали заявку на работу своей мечты? У вас может..

    Частный метод Python: улучшение инкапсуляции и безопасности
    Введение Python — универсальный и мощный язык программирования, известный своей простотой и удобством использования. Одной из ключевых особенностей, отличающих Python от других языков, является..

    Как я автоматизирую тестирование с помощью Jest
    Шутка для победы, когда дело касается автоматизации тестирования Одной очень важной частью разработки программного обеспечения является автоматизация тестирования, поскольку она создает..

    Работа с векторными символическими архитектурами, часть 4 (искусственный интеллект)
    Hyperseed: неконтролируемое обучение с векторными символическими архитектурами (arXiv) Автор: Евгений Осипов , Сачин Кахавала , Диланта Хапутантри , Тимал Кемпития , Дасвин Де Сильва ,..

    Понимание расстояния Вассерштейна: мощная метрика в машинном обучении
    В обширной области машинного обучения часто возникает необходимость сравнивать и измерять различия между распределениями вероятностей. Традиционные метрики расстояния, такие как евклидово..

    Обеспечение масштабируемости LLM: облачный анализ с помощью AWS Fargate и Copilot
    В динамичной области искусственного интеллекта все большее распространение получают модели больших языков (LLM). Они жизненно важны для различных приложений, таких как интеллектуальные..