Accessing user edits to D3 table

[ghost]

I am trying to understand the code in the filter example that is provided on the interaction shiny app, but I am still having trouble understanding how to access user edits to my d3tf Output.

I have a simple table that users can edit. I would like to be able to do calculations on the entered data, but I am not sure how to save the edits to the table from the server side of the R code. My table meals2() is the reactive dataframe that is being edited in the ui.R. My problem is that the code below does not show anything in the ui.R when I display output$filteredmeals3. (My first step towards using the edits as a calculation is to actually see the edits in a new table.)

Any help would be appreciated.

My server.R has

revals <- reactiveValues();
meals3=(reactive({
      meals3<-meals()
      meals3
  }))

revals$meals3 <- meals3;
revals$rowIndex <- 1:nrow(meals3);

observe({
  if(is.null(input$meals2_edit)) return(NULL);
  edit <- input$meals2_edit;

  isolate({
    # need isolate, otherwise this observer would run twice
    # for each edit
    id <- edit$id;
    row <- as.integer(edit$row);
    col <- as.integer(edit$col);
    val <- edit$val;

    # validate input 
    if(col == 0) {
      # rownames
      oldval <- rownames(revals$meals3)[row];
      # rownames can not start with a digit
      if(grepl('^\\d', val)) {
        rejectEdit(session, tbl = "meals3", row = row, col = col,  id = id, value = oldval);
        return(NULL);
      }
    } else if (col %in% c(1, 2, 3)){
      # numeric columns
      if(is.na(suppressWarnings(as.numeric(val)))) {
        oldval <- revals$meals3[row, col];
        # reset to the old value
        # input will turn red briefly, than fade to previous color while
        # text returns to previous value
        rejectEdit(session, tbl = "meals3", row = row, col = col, id = id, value = oldval);
        return(NULL);
      } 
    }

    # accept edits
    if(col == 0) {
      rownames(revals$meals3)[row] <- val;
    } else if (col %in% c(1, 2, 3)) {
      revals$meals3[row, col] <- as.numeric(val);
      val = round(as.numeric(val), 1)
    }
    # confirm edits
    confirmEdit(session, tbl = "meals3", row = row, col = col, id = id, value = val);
  })
})

output$filteredmeals3 <- renderTable({
  if(is.null(revals$rowIndex)) return(invisible());    
  if(is.null(revals$meals3)) return(invisible());
  revals$meals3[revals$rowIndex, ];
});

I get the following error Error in 1:nrow(meals3) : argument of length 0

I can make edits to my table that is rendered by d3tf(meal2(),...) but I can't get the second edited table to display.

[ThomasSiegmund]

Hard to tell without the complete code what The Problem might be. For a first test I would put print(input$meals2_edit) at the start of the observer to see the edit events in the console.

[ghost]

Hi Thomas,

When I edit the table, this prints:

Warning: Unhandled error in observer: object of type 'closure' is not subsettable
observe({
    print(input$meals2_edit)
    if (is.null(input$meals2_edit)) 
        return(NULL)
    edit <- input$meals2_edit
    isolate(edit <- edit)
    isolate({
        id <- edit$id
        row <- as.integer(edit$row)
        col <- as.integer(edit$col)
        val <- edit$val
        if (col == 0) {
            oldval <- rownames(revals$editable)[row]
            if (grepl("^\\d", val)) {
                rejectEdit(session, tbl = "editable", row = row, 
                  col = col, id = id, value = oldval)
                return(NULL)
            }
        }
        else if (col %in% c(1, 2, 3)) {
            if (is.na(suppressWarnings(as.numeric(val)))) {
                oldval <- revals$editable[row, col]
                rejectEdit(session, tbl = "editable", row = row, 
                  col = col, id = id, value = oldval)
                return(NULL)
            }
        }
        if (col == 0) {
      [... truncated]

Here is the most recent version of server.R table edit code:

########EDITS TO TABLE
revals <- reactiveValues();
editable=reactive({
      editable<-meals()
      editable
  })

revals$editable <- reactive({editable()})
revals$rowIndex <- reactive({1:nrow(editable())  })

observe({
  print(input$meals2_edit)
  if(is.null(input$meals2_edit)) return(NULL);
  edit <- input$meals2_edit;

  isolate({
    # need isolate, otherwise this observer would run twice
    # for each edit
    id <- edit$id;
    row <- as.integer(edit$row);
    col <- as.integer(edit$col);
    val <- edit$val;

    # validate input 
    if(col == 0) {
      # rownames
      oldval <- rownames(revals$editable)[row];
      # rownames can not start with a digit
      if(grepl('^\\d', val)) {
        rejectEdit(session, tbl = "editable", row = row, col = col,  id = id, value = oldval);
        return(NULL);
      }
    } else if (col %in% c(1, 2, 3)){
      # numeric columns
      if(is.na(suppressWarnings(as.numeric(val)))) {
        oldval <- revals$editable[row, col];
        # reset to the old value
        # input will turn red briefly, than fade to previous color while
        # text returns to previous value
        rejectEdit(session, tbl = "editable", row = row, col = col, id = id, value = oldval);
        return(NULL);
      } 
    }

    # accept edits
    if(col == 0) {
      rownames(revals$editable)[row] <- val;
    } else if (col %in% c(1, 2, 3)) {
      revals$editable[row, col] <- as.numeric(val);
      val = round(as.numeric(val), 1)
    }
    # confirm edits
    confirmEdit(session, tbl = "editable", row = row, col = col, id = id, value = val);
  })
})

output$filteredmeals3 <- renderTable({
  if(is.null(revals$rowIndex)) return(invisible());    
  if(is.null(revals$editable)) return(invisible());
  revals$editable[revals$rowIndex, ];
});

Is my problem that revals is reactive?

[ThomasSiegmund]

Sorry, I don't understand the meals3 stuff.

If you have and editable d3tf object it's normal that you see a NULL response until you start editing values. Once you edit it, you should see a list printed, containing edit_id, row, column and value.

So what you get back from the meals2_edit input is not the table, but the coordinates of the edited cell and the new content of this cell.

I guess in most situations you will have a copy of the original table as a reactive value. You can apply the edit events after validation to this copy to reflect what's in the browser.

In your code above you read in the observer from meals2_edit, but send the confirm or reject message to a table "meals3". This wont work.

[ghost]

I see how that is confusing. I created meals3 (named 'editable' in my last post) from meals2. meals2() is the reactive table that d3tf uses. however, I couldn't figure out how to get everything in your example to work with meals2() as a reactive object, so I tried to create a non reactive dataframe but I failed at that. In my example, meals2() is analogous to mtcars. But mtcars is not reactive.

[ghost]

In my code below I show a new change (####Added this isolate function) - this allows all edits to print to the console without error. However, the final table (tableOutput("filteredmeals3")) is only showing a table with one row containing the edits for the first column, but no other data. In the image below, Adjust Ingredients is the table that can be edited (meals2()). The output in step 3 in the image is where the results of the edited table should be showing.

#allow reactive values
revals <- reactiveValues();

#create copy of editable dataframe
editable=reactive({
      editable<-meals()
      editable
  })

####Added this isolate function
isolate({
revals$editable <- editable()
revals$rowIndex <- 1:nrow(editable())  

observe({
  print(input$meals2_edit)
  if(is.null(input$meals2_edit)) return(NULL);
  edit <- input$meals2_edit;

isolate({
revals$editable <- editable()
revals$rowIndex <- 1:nrow(editable())  

observe({
  print(input$meals2_edit)
  if(is.null(input$meals2_edit)) return(NULL);
  edit <- input$meals2_edit;

  isolate({
    # need isolate, otherwise this observer would run twice
    # for each edit
    id <- edit$id;
    row <- as.integer(edit$row);
    col <- as.integer(edit$col);
    val <- edit$val;

    # validate input 
    if(col == 0) {
      # rownames
      oldval <- rownames(revals$editable)[row];
      # rownames can not start with a digit
      if(grepl('^\\d', val)) {
        rejectEdit(session, tbl = "editable", row = row, col = col,  id = id, value = oldval);
        return(NULL);
      }
    } else if (col %in% c(1, 2, 3)){
      # numeric columns
      if(is.na(suppressWarnings(as.numeric(val)))) {
        oldval <- revals$editable[row, col];
        # reset to the old value
        # input will turn red briefly, than fade to previous color while
        # text returns to previous value
        rejectEdit(session, tbl = "editable", row = row, col = col, id = id, value = oldval);
        return(NULL);
      } 
    }

    # accept edits
    if(col == 0) {
      rownames(revals$editable)[row] <- val;
    } else if (col %in% c(1, 2, 3)) {
      revals$editable[row, col] <- as.numeric(val);
      val = round(as.numeric(val), 1)
    }
    # confirm edits
    confirmEdit(session, tbl = "editable", row = row, col = col, id = id, value = val);
  })
})})

output$filteredmeals3 <- renderTable({
  if(is.null(revals$rowIndex)) return(invisible());    
  if(is.null(revals$editable)) return(invisible());
  revals$editable[revals$rowIndex, ];
});

[ThomasSiegmund]

I'm surprised that you see edits at all, if you put the complete observer in an isolate(). Shouldn't this block all reactivity?

Anyways, if you see the edit events in the observer, then you should be able to follow up step by step, e.g. by printing revals$editible at the beginning and at the end of the observe(). You could also check revals$rowIndex, since this is the second variable your filteredmeas3 output depends on.

You may also want to check if the layout of your table matches the input validation in the observer. The validation code only allows for edits in columns 1, 2, and 3.

[ThomasSiegmund]

Closing this because of inactivity.