如何在`reactiveValues()`中使R中的反应表复制 [英] how to make a copy of reactive table in R shiny in `reactiveValues()`

查看:42
本文介绍了如何在`reactiveValues()`中使R中的反应表复制的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我正在构建一个应用程序,用户可以在该应用程序中对数据表进行编辑,然后单击一个按钮以反映此数据表的不可编辑副本中的更改(在最终项目中,我将需要有两个数据集,它们需要手动匹配),但目前,这个小MWE展示了我在复制反应性表的副本时存在的问题,可以在其中进行更改,而无需更改原始反应性表的数据.我想使此应用程序正常运行,在其中单击"dat_joined $ data/output $ mytable"表中的一个单元格,然后在新表mydf $ data/output $ table2中反映这些更改.最初要做mydf $ data(在进行任何更改之前)需要是dat_joined $ data的副本.这是此问题和解答的后续内容:

I am building app where a user can make edits to a datatable and the hit a button to reflect the changes in a non-editable copy of this datatable (in the final project, I will need to have two datasets that need to be matched manually), but for now this small MWE shows the problem I have with making a copy of the reactive table in which changes can be made, without changing the data of the original reactive table. I would like to make this app work, where you click edit a cell in the table dat_joined$data/output$mytable and that those changes do reflect in a new table mydf$data/output$table2. To do mydf$data initially (before any changes are made) needs to be a copy of dat_joined$data This is a follow up on this question and answer: how to make a copy of a reactive value in shiny server function


library(shiny)
library(DT)
library(shinyWidgets)
library(tidyverse)


# create master dataframe
dat_total <- tibble(ID_1 = 1:10,  names =   letters[1:10],
                    ID_2 = 11:20, names_2 = LETTERS[c(3:5, 1, 2, 6:8, 10, 9)])


shinyApp(
  ui = fluidPage(
    title = 'Radio button and a dropdown manue ',
    sliderInput("n_rows_table", "Number of rows:",
                min = 0, max = 10,
                value = 5),
    actionBttn(
      inputId = "button_1",
      label = "Make tables",
      size = "sm",
      color = "warning"
    ),
    DT::dataTableOutput("mytable"),
    actionBttn(
      inputId = "button_2",
      label = "Process",
      size = "sm",
      color = "success"),
    DT::dataTableOutput("table2")),
  
  server = function(input, output, session) {
    
    # set up reactive values
    dat_left <- reactiveValues(data=NULL)
    dat_right <- reactiveValues(data=NULL)
    dat_joined <- reactiveValues(data=NULL)
    
    
    # create reactive daraframe
    dat <- eventReactive(input$button_1, {
      dat_total[1:input$n_rows_table, ] %>%
        rowid_to_column()})
    
    
    # Split the data into a right and a left set
    
    observe({
      dat_left$data <- dat() %>%
        select(rowid, ID_1, names)
    })
    
    observe({
      dat_right$data <- dat() %>%
        select(rowid,  ID_2, names_2,ID_1)
    })
    
    
    # join these again
    # This is needed because my actual app will
    # be used to manually  match 2 datasets
    observe({
      if (is.null( dat_right$data )) {
        NULL   
      }else{
        dat_joined$data <- left_join(dat_left$data,
                                     dat_right$data,
                                     by = "rowid")
      }
    })
    
    
    # Print the the datasets
    
    output$mytable <- renderDT({
      datatable(dat_joined$data , 
                rownames = F,
                editable = "cell")
    })
    # I want to make a copy of the dat_joined$data dataset into dat$mydf
    # none of these function as expected
    
    #mydf <- reactiveValues(data=isolate(dat_joined$data))
    #mydf <- reactiveValues(data=local(dat_joined$data))
    #mydf <- reactiveValues(data=dat_joined$data)
    #mydf <- reactiveValues(data=NULL)
    
    # This works, but only saves the cells to w
    mydf <- reactiveValues(data=matrix(NA, nrow=10, ncol = 5))
    
    # Ideally the computation only happens when this both an edit is made 
    # and the button is pressed (now I need to press it between every edit)
    
    # validate_event <- reactive({
    #   req(input$mytable_cell_edit) & req(input$button_2)
    # })
    
    
    #observeEvent(input$button_2validate_event(), {  DOes not work
  
      observeEvent(input$button_2,{
      info = input$mytable_cell_edit
      str(info)
      i = info$row
      j = info$col
      v = info$value
      
      mydf$data[i, j] <- DT::coerceValue(v, mydf$data[i, j])
      
    })
    
    
    # print
    output[["table2"]] <- renderDT({
      datatable(mydf$data)
    })
    
  }
)

解决方案

Any changes you make in the top table is reflected in the bottom table after you press the button "Process". Try this

library(shiny)
library(DT)
library(shinyWidgets)
library(tidyverse)


# create master dataframe
dat_total <- tibble(ID_1 = 1:10,  names =   letters[1:10],
                    ID_2 = 11:20, names_2 = LETTERS[c(3:5, 1, 2, 6:8, 10, 9)])


shinyApp(
  ui = fluidPage(
    title = 'Radio button and a dropdown manue ',
    sliderInput("n_rows_table", "Number of rows:",
                min = 0, max = 10,
                value = 5),
    actionBttn(
      inputId = "button_1",
      label = "Make tables",
      size = "sm",
      color = "warning"
    ),
    DT::dataTableOutput("mytable"),
    actionBttn(
      inputId = "button_2",
      label = "Process",
      size = "sm",
      color = "success"),
    DT::dataTableOutput("table2")),
  
  server = function(input, output, session) {
    
    # set up reactive values
    dat_left <- reactiveValues(data=NULL)
    dat_right <- reactiveValues(data=NULL)
    dat_joined <- reactiveValues(data=NULL)
    dfon <- reactiveValues(top=NULL,
                           bottom=NULL)
    
    # create reactive daraframe
    dat <- eventReactive(input$button_1, {
      dat_total[1:input$n_rows_table, ] %>%
        rowid_to_column()})
    
    
    # Split the data into a right and a left set
    
    observe({
      req(dat())
      dat_left$data <- dat() %>%
        dplyr::select(rowid, ID_1, names)
    })
    
    observe({
      req(dat())
      dat_right$data <- dat() %>%
        dplyr::select(rowid,  ID_2, names_2,ID_1)
    })
    
    
    # join these again
    # This is needed because my actual app will
    # be used to manually  match 2 datasets
    observe({
      req(dat())
      if (!is.null( dat_right$data )) {
        dat_joined$data <- left_join(dat_left$data,
                                     dat_right$data,
                                     by = "rowid")
      }
    })
    
    observe({ ###assign your orig data to a reactiveValues object
      req(dat_joined$data)
      if (!is.null(dat_joined$data)) {
        dfon$top <- dat_joined$data 
      }
    })
    
    
    # Print the the datasets
    
    output$mytable <- renderDT({
      datatable(dfon$top, 
                rownames = F,
                editable = "cell")
    })
    
    # Ideally the computation only happens when this both an edit is made 
    # and the button is pressed (now I need to press it between every edit)

    observeEvent(input$mytable_cell_edit, {
      info = input$mytable_cell_edit
      str(info)
      #i = info$row
      #j = info$col + 1  # offset by 1
      #v = info$value
      
      #dfon$top[i, j] <<- DT::coerceValue(v, dfon$top[i, j])
      dfon$top <<- editData(dfon$top, info)
    })
    
    observeEvent(input$button_2,{
      dfon$bottom <- dfon$top
      output$table2 <- renderDT({
        datatable(dfon$bottom)
      })
    })
    
    ## further editing of dfon$bottom is performed below...with...observeEvent(input$table2_cell_edit, {...
    
  }
)

In the output below, I have entered cccc for 3rd element in names column, but I have not clicked on the button Process. Therefore, the edited cell is not reflected in the bottom table.

这篇关于如何在`reactiveValues()`中使R中的反应表复制的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆