кнопка загрузки исчезает при отмене выбора столбца или редактировании таблицы данных в блестящем приложении - PullRequest
Новая
       57

кнопка загрузки исчезает при отмене выбора столбца или редактировании таблицы данных в блестящем приложении

1 голос
/ 01 октября 2019

Я создал блестящее приложение для загрузки настроенной и редактируемой таблицы данных. Здесь я использую iris набор данных в качестве примера.

Согласно этому сообщению , я добавляю кнопку для загрузки всего набора данных в формате csv.

Однако возникла одна проблема. Когда я попытался снять галочку с какого-либо столбца ИЛИ редактировать таблицу, кнопка загрузки просто исчезла. И это никогда не появится снова.

Я часами пытался это выяснить, но безуспешно. Кто-нибудь знает, почему это происходит? Заранее большое спасибо. 

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


    # UI
    ui = fluidPage(
                   downloadButton("download1","Download iris as csv"),
                   DT::dataTableOutput('tbl'),
                   checkboxGroupInput('datacols', 
                                      label='Select Columns:',
                                      choices= c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Specie'),
                                      selected = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Specie'),
                                      inline=TRUE )

                   )

    # SERVER
    server = function(input, output) {



        df = reactiveValues()

        observe ({

            df$dat = iris %>% select(one_of(input$datacols))
        })
        # render DT
        output$tbl = renderDT({
                datatable(df$dat,
                editable = "cell",
                callback = JS("$('div.dwnld').append($('#download1'));"),
                extensions = "Buttons",
                options = list(
                    dom = 'B<"dwnld">frtip',
                    buttons = list(
                        "copy" ) ) )

        })


        observeEvent(input[["tbl_cell_edit"]], {
            cellinfo <- input[["tbl_cell_edit"]]
            df$dat  <- editData(df$dat,  input[["tbl_cell_edit"]] )
        })

        output$download1 <- downloadHandler(
            filename = function() {
                paste("data-", Sys.Date(), ".csv", sep="")
            },
            content = function(file) {
                write.csv(df$dat, file)
            }
        )

    }

shinyApp(ui, server)

1 Ответ

1 голос
/ 02 октября 2019

Очень интересный случай.

Каждый раз, когда вы редактируете ячейку или выбираете / отменяете выбор столбца, это меняет df$dat, а затем таблица перерисовывается. Но тогда элемент #download1, который был включен в таблицу, больше не существует в DOM.

Нам нужно найти способ выбора / отмены выбора некоторых столбцов и редактирования некоторых ячеек без перерисовки таблицы. Вот один из них: 

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

# UI
ui = fluidPage(
  downloadButton("download1", "Download iris as csv"),
  DTOutput('tbl'),
  checkboxGroupInput(
    'datacols', 
    label='Select Columns:',
    choices= c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Species'),
    selected = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Species'),
    inline=TRUE)

)

# SERVER
server = function(input, output) {

  dat <- iris

  # render DT
  output$tbl = renderDT({
    datatable(dat,
              editable = "cell",
              callback = JS(
                "$('div.dwnld').append($('#download1'));",
                "var checkboxes = $('input[name=datacols]');",
                "checkboxes.each(function(index,value){",
                "  var column = table.column(index+1);",
                "  $(this).on('click', function(){",
                "    if($(this).prop('checked')){",
                "      column.visible(true);",
                "    }else{",
                "      column.visible(false);",
                "    }",
                "  });",
                "});"
              ),
              extensions = "Buttons",
              options = list(
                dom = 'B<"dwnld">frtip',
                buttons = list("copy")
              ) 
    )

  })

  observeEvent(input[["tbl_cell_edit"]], {
    cellinfo <- input[["tbl_cell_edit"]]
    dat <<- editData(dat, cellinfo, "tbl")
  })

  output$download1 <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(dat %>% select(one_of(input$datacols)), file)
    }
  )

}

shinyApp(ui, server)
...