Skip to content

Instantly share code, notes, and snippets.

@senthilthyagarajan
Created April 18, 2019 17:18
Show Gist options
  • Save senthilthyagarajan/a714446c9acd8127e4cbef6ede09b1fc to your computer and use it in GitHub Desktop.
Save senthilthyagarajan/a714446c9acd8127e4cbef6ede09b1fc to your computer and use it in GitHub Desktop.
Edit DT with modules
### Libraries
library(shiny)
library(dplyr)
library(DT)
### Data
input_data <- data.frame(Brand = c("Brand1", "Brand2","Brand3"),
ratio = c (.5, .5, .5),
cost = c(2000, 3000, 4000),
stringsAsFactors = FALSE) %>%
mutate(updated_price = cost * ratio)
### Module
modFunction <- function(input, output, session, data,reset) {
v <- reactiveValues(data = data)
proxy = dataTableProxy("mod_table")
observeEvent(input$mod_table_cell_edit, {
print(names(v$data))
info = input$mod_table_cell_edit
str(info)
i = info$row
j = info$col
k = info$value
str(info)
isolate(
if (j %in% match(c("ratio","cost","updated_price"), names(v$data))) {
print(match(c("ratio","cost", "updated_price"), names(v$data)))
v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
print(v$data)
if (j %in% match("cost", names(v$data))) {
v$data$updated_price <<- v$data$cost * v$data$ratio
}
if (j %in% match("ratio", names(v$data))) {
v$data$updated_price <<- v$data$cost * v$data$ratio
}
} else {
stop("You are not supposed to change this column.") # check to stop the user from editing only few columns
}
)
replaceData(proxy, v$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
### Reset Table
observeEvent(reset(), {
v$data <- data # your default data
})
print(isolate(colnames(v$data)))
output$mod_table <- DT::renderDataTable({
DT::datatable(v$data, editable = TRUE)
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("mod_table"))
}
### Shiny App
shinyApp(
ui = basicPage(
mainPanel(
actionButton("reset", "Reset"),
tags$hr(),
modFunctionUI("editable")
)
),
server = function(input, output) {
demodata<-input_data
callModule(modFunction,"editable", demodata,
reset = reactive(input$reset))
}
)
@TahorSuiJuris
Copy link

Excellent!

Q. Would this work similar to POST BY "observeevent" for updating the edited data?

library(flexdashboard) # Flexdashboard to create a frame for the content
library(dplyr)         # tidy data manipulation
library(leaflet)       # Leaflet for the interactive map
library(DT)            # DT for the interactive table
library(crosstalk)     # Crosstalk for widget interactivity
library(shiny)         # Shiny web app to broaden the capabilities of Crosstalk

# Ion icons and Font Awesome for icons

# user interface just shows the table
ui <-
    fluidPage(
        title = 'Base List Table',
        h1('Base List Using Server-side Processing'),
        
        #sidebarLayout(
        #    sidebarPanel(

        #    ),
        
        
        #fluidRow
        mainPanel(column(12, div(
       
        dataTableOutput("dataTable")
    ))))#)

# server is where all calculations are done, tables are pre-rendered
server <- function(input, output, session) {
    # load CSV file
    myCSV <-
        read.csv(
            'https://docs.google.com/spreadsheets/d/e/2PACX-1vToTirzRAHEuMiBXMOt5eyWVK342PnU2mpjl3nZCaveQdWPoFpXeX-oMhPZDZDhk9hBbOtUWQn0w29H/pub?output=csv'
        )
    #-----------------------------------------------------------------------------
    #  render data table
    #-----------------------------------------------------------------------------
    
    output$dataTable <- renderDT(myCSV,
                                 # data
                                  class = "display nowrap compact",
                                  # style
                                 selection = "single",
                                 # set selection
                                 filter = "top",
                                 # location of column filters
                                 editable = TRUE,
                                 # cells editable
                                 #style ="bootstrap",
                                 #
                                 rownames = TRUE,
                                 #
                                 options = list(searching = TRUE, bPaginate = TRUE, info = TRUE,
                                                columnDefs = list(list(visible = FALSE, targets = c(0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10))))) # hide ID column; first column indexed with 0
    
    proxyTeams = dataTableProxy("dataTable")
                                 
                            
                                    
}

# run the app
shinyApp(ui, server)

@Bijurikaaa
Copy link

I have tried
v<- reactiveValues(data = data)
however it is throwing the below error
Error in reactiveValues(data = data) :
argument "data" is missing, with no default

I am unable to understand the argument myself, could you please help me with this?

@SzarR
Copy link

SzarR commented Jun 12, 2020

I couldn't get this code to work for me either, same issues.

@grokasper
Copy link

This code has been super helpful! I need to incorporate additional input filters, but when I try to filter the initial data frame to allow for this and run the code I get:
"Error in dplyr::filter(): caused by error in mask$eval_all_filter() object 'input' not found"

Do you know how I could incorporate other drop down filters into this app?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment