Editable calculation with DT table in Shiny - r

I've been at this for awhile and have read a bunch but I still can't wrap my head around how to make this work. Is there a simple solution?
I want to edit a DT table in my shiny app and, upon editing, I'd like there to be a change in a column that aggregates two values.
Here is an example:
library(tidyverse)
library(shiny)
library(DT)
mt <- mtcars %>%
select(mpg, cyl) %>%
head()
ui <- fluidPage(
DTOutput(outputId = "final_tbl")
)
server <- function(input, output){
dat <- reactive({
d <- mt %>%
mutate(total = mpg + cyl)
d
})
output$final_tbl <- renderDT({
dat() %>%
datatable(editable = TRUE)
})
}
shinyApp(ui, server)
This produces a simple editable table with a total column that adds up mpg and cyl. What I'd like to be able to do is edit the cyl value and have the change reflected in the summed total column. Is there an easy solution to this?

You need to use _cell_edit as shown below in a ObserveEvent.
mt <- mtcars %>%
select(mpg, cyl) %>%
head()
ui <- fluidPage(
DTOutput(outputId = "final_tbl")
)
server <- function(input, output){
df1 <- reactiveValues(data=NULL)
dat <- reactive({
d <- mt %>%
mutate(total = mpg + cyl)
d
})
observe({
df1$data <- dat()
})
output$final_tbl <- renderDT({
df1$data %>%
datatable(editable = TRUE)
})
observeEvent(input$final_tbl_cell_edit, {
info = input$final_tbl_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# Without this line the table does not change but with it it jumps to row 1 after an edit.
df1$data[i, j] <<- (DT::coerceValue(v, df1$data[i, j]))
df1$data[,"total"] <<- df1$data[,"mpg"] + df1$data[,"cyl"] ## update the total column
})
}
shinyApp(ui, server)

Related

How to group data dynamically in r shiny app

I am creating a shiny App where it will do two things on mtcars dataset
group data based on user selected values and calculate the mean mpg
and then filter based on selected values to display the output
library(shiny)
library(dplyr)
ui <- fluidPage(
titlePanel(" APP"),
sidebarLayout(
sidebarPanel(selectInput("x","Select cylinder",choices = c(mtcars$cyl),multiple = TRUE),
selectInput("y","Select gear",choices = c(mtcars$gear),multiple = TRUE),
submitButton("Submit")),
mainPanel(
tableOutput("m")
)))
server <- function(input,output){
check <- reactive({
if(is.null(input$x) & is.null(input$y)){
mtcars %>% summarise(Average_mpg = mean(mpg))
}else if(!is.null(input$x) & is.null(input$y)){
a <- mtcars %>% group_by(cyl) %>% summarise(Average_mpg = mean(mpg))
a %>% filter(cyl==input$x)
}else if(is.null(input$x) & !is.null(input$y)){
a <- mtcars %>% group_by(gear) %>% summarise(Average_mpg = mean(mpg))
a %>% filter(gear==input$y)
}else{
a <- mtcars %>% group_by(gear,cyl) %>% summarise(Average_mpg = mean(mpg))
a %>% filter(cyl==input$x & gear==input$y)
}
})
output$m <- renderTable(
check()
)
}
shinyApp(ui = ui, server = server)
Currently I have hard coded all possible combination using if else statement and then realized its not efficient way. If the filters/widgets increase then its difficult to manage
for e.g. If I add one more filter here for variable "carb" in mtcars dataset I have to include all possible scenarios what the user will select and hard code it.
My actual app is having 5 -6 more filters.
Is there any way where whatever the user selects the app will group by on the fly and then filter and show results.
This is not a perfect approach as it still involves some copy & paste and duplicated code. But as a first step it gets rid of the if-else to filter your data:
library(shiny)
library(dplyr)
choices_cyl <- unique(mtcars$cyl)
choices_gear <- unique(mtcars$gear)
ui <- fluidPage(
titlePanel(" APP"),
sidebarLayout(
sidebarPanel(
selectInput("x", "Select cylinder", choices = choices_cyl, multiple = TRUE),
selectInput("y", "Select gear", choices = choices_gear, multiple = TRUE),
submitButton("Submit")
),
mainPanel(
tableOutput("m")
)
)
)
server <- function(input, output) {
check <- reactive({
cyls <- input$x
gears <- input$y
grps <- c("cyl", "gear")[c(!is.null(cyls), !is.null(gears))]
if (is.null(cyls)) cyls <- choices_cyl
if (is.null(gears)) gears <- choices_gear
mtcars %>%
filter(cyl %in% cyls, gear %in% gears) %>%
group_by(across(all_of(grps))) %>%
summarise(Average_mpg = mean(mpg))
})
output$m <- renderTable(
check()
)
}
shinyApp(ui = ui, server = server)

R shiny checkergroupinputbox Group by reactive input, summarize by reactive input

I am trying to build a shiny app that gives user the flexibility to choose the variables for group by and summarize. Checkbox will have an option for selecting group by variables. Right now I haven't given measure variables as selections, since I struggling with group by. I want the numbers to be aggregated basis the selection.
library(shiny)
library(ggplot2) # for the diamonds dataset
library(shinydashboard)
library(dplyr)
y1<-diamonds
ui <- fluidPage(
checkboxGroupInput("variable", "Variables to show:",
c("cut","color","clarity"),selected = "cut"),
tableOutput("data"),
textOutput("result")
)
server <- function(input, output, session) {
base <- reactive({
groupby <- enquo(input$variable)
print(groupby)
res <-y1%>% group_by(!!!groupby,x) %>%
tally() %>%
ungroup() %>%
summarise(sum = sum(x)) %>%
pull()
res
})
output$result <- renderText({
input$variable
})
output$data<-renderTable({
base()
}
)
}
shinyApp(ui, server)
Thanks,
Hema
I'm not sure that I understood your question exactly, but maybe something like this:
library(shiny)
library(ggplot2) # for the diamonds dataset
library(shinydashboard)
library(dplyr)
y1<-diamonds
ui <- fluidPage(
checkboxGroupInput("variable", "Variables to show:",
c("cut","color","clarity"),selected = "cut"),
tableOutput("data"),
textOutput("result")
)
server <- function(input, output, session) {
base <- reactive({
res <- y1 %>% group_by(eval(parse(text = input$variable)),x) %>%
tally() %>%
#ungroup() %>%
summarise(sum = sum(x)) %>%
pull()
res
})
output$result <- renderText({
input$variable
})
output$data<-renderTable({
base()
})
}
shinyApp(ui, server)
if it's possible to select multiple from the check boxes such that you'd want something like group_by(x,y) this may help you get what you want:
group_by(across(all_of(input$group)))

How to incorporate the suffix of an output$suffix name into an input$suffix_rows_selected function in R shiny?

I am trying to get the suffix of an output$suffix name in R Shiny and incorporate it into the input$suffix_rows_selected function. The drilldown table is coming empty. Would someone have any idea of what am I doing wrong?
Function that I am trying to build:
f.drilldata <- function(base.summary, base.drilldown, suffix.output, group_var){
group = enquo(group_var)
base.summary = base.summary %>% mutate(var = !!group)
base.drilldown = base.drilldown %>% mutate(var = !!group)
#input = expr(!!glue("input${suffix.output}_rows_selected"))
input = paste0(suffix.output,'_rows_selected')
validate(need(length(input[[input]]) > 0, ''))
selected_rows <- base.summary[as.integer(input[[input]]), ]$var
base.drilldown[base.drilldown$var %in% selected_rows, ]
}
Error Example:
library("dplyr")
library("shiny")
library("DT")
tbl.summary <- group_by(iris, Species) %>% summarise(Count = n())
tbl.drilldown <- iris
ui <- fluidPage(
DTOutput("output.summary.name")
, DTOutput("output.drilldown.name"))
server <- function(input, output){
# display the data that is available to be drilled down
output$output.summary.name <- renderDT(tbl.summary)
# subset the records to the row that was clicked through f.drilldata function
drilldata <- reactive({ f.drilldata(tbl.summary, tbl.drilldown, 'output.summary.name', Species) })
# display the subsetted data
output$output.drilldown.name <- renderDT(drilldata())}
shinyApp(ui, server)
Example that works but out of the f.drilldata function
library("dplyr")
library("shiny")
library("DT")
tbl.summary <- group_by(iris, Species) %>% summarise(Count = n())
tbl.drilldown <- iris
ui <- fluidPage(
DTOutput("output.summary.name")
, DTOutput("output.drilldown.name"))
server <- function(input, output){
output$output.summary.name <- renderDT(tbl.summary)
drilldata <- reactive({ validate( need(length(input$output.summary.name_rows_selected) > 0, "Select rows to drill down!"))
selected_species <-
tbl.summary[as.integer(input$output.summary.name_rows_selected), ]$Species
tbl.drilldown[tbl.drilldown$Species %in% selected_species, ] })
output$output.drilldown.name <- renderDT(drilldata())}
shinyApp(ui, server)
I have found a simple solution by just adding the entire input (input$output.summary.name_rows_selected) as an argument of the function as below.
library("dplyr")
library("shiny")
library("DT")
f.drilldata <- function(base.summary, base.drilldown, input, group_var){
group = enquo(group_var)
base.summary = base.summary %>% mutate(var = !!group)
base.drilldown = base.drilldown %>% mutate(var = !!group)
validate(need(length(input) > 0, ''))
selected_rows <- base.summary[as.integer(input), ]$var
base.drilldown[base.drilldown$var %in% selected_rows, ]
}
tbl.summary <- group_by(iris, Species) %>% summarise(Count = n())
tbl.drilldown <- iris
ui <- fluidPage(
DTOutput("output.summary.name")
, DTOutput("output.drilldown.name"))
server <- function(input, output){
output$output.summary.name <- renderDT(tbl.summary)
drilldata <- reactive({ f.drilldata(tbl.summary, tbl.drilldown,
input$output.summary.name_rows_selected, Species) })
output$output.drilldown.name <- renderDT(drilldata())}
shinyApp(ui, server)

How to get the rows corresponding to a plot selection in shiny

I have a bar graph which is part of a shiny app. I have created it with plotly. I would like the user to be able to select a part of the graph (click) and on clicking a datatable would show all rows corresponding to the values given in the hover text from that part of the chart.
So far I am able to show the output from event.data which isnt very interesting. How can I show the relevant rows from the original table?
library(plotly)
library(shiny)
ui <- fluidPage(
uiOutput("ChooserDropdown"),
plotlyOutput("plot2"),
DT::dataTableOutput("tblpolypDetail2")
)
server <- function(input, output, session) {
output$plot2 <- renderPlotly({
# use the key aesthetic/argument to help uniquely identify selected observations
#key <- row.names(mtcars)
browser()
p <- ggplot(iris,aes_string(iris$Species,input$Chooser)) + geom_col()
ggplotly(p,source = "subset") %>% layout(dragmode = "select")
})
output$tblpolypDetail2 <- renderDataTable({
event.data <- event_data("plotly_click", source = "subset")
print(event.data)
})
output$ChooserDropdown<-renderUI({
selectInput("Chooser", label = h4("Choose the endoscopic documentation column"),
choices = colnames(iris) ,selected = 1
)
})
}
shinyApp(ui, server)
I created a small demo where you can highlight rows in datatable by clicking the plotly graph.
You need to do it in two steps:
Map pointNumber of a click to rows in datatable(), you can create an external table for it.
You need to create a dataTableProxy where you can update a datatable
library(plotly)
library(DT)
library(shiny)
library(dplyr)
data <- as_tibble(iris) %>%
group_by(Species) %>%
summarise(avg = mean(Sepal.Width)) %>%
mutate(Species = as.character(Species))
species_mapping <- data.frame(
Species = data$Species,
row_id = 1:length(data$Species),
stringsAsFactors = FALSE
)
ui <- fluidPage(
DT::dataTableOutput("table"),
plotlyOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- data %>%
ggplot() +
geom_col(aes(x = Species, y = avg))
# register this plotly object
plotly_object <- ggplotly(p,source = "source1")
event_register(plotly_object,event = "plotly_click")
plotly_object
})
output$table <- DT::renderDataTable(data)
# create a proxy where we can update datatable
proxy <- DT::dataTableProxy("table")
observe({
s <- event_data("plotly_click",source = "source1")
req(!is.null(s))
# map point number to Species
row_clicked <- species_mapping[s$pointNumber + 1,"row_id"]
proxy %>%
selectRows(NULL) %>%
selectRows(row_clicked)
})
}
shinyApp(ui, server)

How to use a reactive variable in server Shiny

I would like to create an application such as below, only at the beginning is to choose the number of cylinders. The following example selects a database, I would like to give up and go straight to the selection of cylinders. Can I use the filter option here?
My idea:
df_mtcars <- reactive({
cylinder_selected <- as.numeric(input$si_cylinders[1])
df <- mtcars %>% filter(cyl == cylinder_selected)
return(df)
})
My code:
ui:
library(radarchart)
shinyUI(pageWithSidebar(
headerPanel("Car Comparison Radar"),
sidebarPanel(
uiOutput("choose_dataset"),
uiOutput("choose_car"),
uiOutput("choose_columns")
),
mainPanel(
chartJSRadarOutput('radar', height = '350px')
)
))
server:
library(shiny)
library(radarchart)
shinyServer(function(input, output) {
# choose dataset but I want choose cyl
output$choose_dataset <- renderUI({
data_sets <- "mtcars"
selectInput("dataset", "Data set", data_sets)
})
# select a car
output$choose_car <- renderUI({
selectInput("car","car",as.list(rownames(get(input$dataset))))
})
# Check boxes
output$choose_columns <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$dataset))
return()
# Get the data set with the appropriate name
dat <- get(input$dataset)
colnames <- names(dat)
# Create the checkboxes and select them all by default
checkboxGroupInput("columns", "Choose columns",
choices = colnames,
selected = colnames)
})
output$radar <- renderChartJSRadar({
# Get the data set
dat <- get(input$dataset)
# Make sure columns are correct for data set (when data set changes, the
# columns will initially be for the previous data set)
if (is.null(input$columns) || !(input$columns %in% names(dat)))
return()
# Keep the selected columns
dat <- dat[, input$columns, drop = FALSE]
#reform data for plot
dat <- as.data.frame(t(dat), stringsAsFactors = FALSE)
dat$labs <- row.names(dat)
dat <- dat[, c('labs', input$car)]
chartJSRadar(dat)
})
})
As it is uiOutput("choose_car") gives you all car possibilities. If you add a selectInputfor selection of cylinders you will have a problem, because you have some specific cars for each cylinder numbers.
So you could have your selectInputfor cars conditional on selectInputfor cylinders.
You can remove uiOutput("choose_dataset") on your own so based on your example you could try this:
ui = pageWithSidebar(
headerPanel("Car Comparison Radar"),
sidebarPanel(
uiOutput("choose_dataset"),
uiOutput("choose_cyclinder"),
uiOutput("choose_car"),
uiOutput("choose_columns")
),
mainPanel(
chartJSRadarOutput('radar', height = '350px')
)
)
server = function(input, output) {
output$choose_cyclinder <- renderUI({
temp <- mtcars %>% group_by(cyl) %>% summarise(Counts = n())
cyl <- levels(as.factor(temp$cyl))
selectInput("select_cyl", "Choose a cylinder", as.list(cyl), selected=TRUE, multiple = FALSE)
})
# choose dataset but I want choose cyl
output$choose_dataset <- renderUI({
data_sets <- "mtcars"
selectInput("dataset", "Data set", data_sets)
})
# select a car
output$choose_car <- renderUI({
dat <- get(input$dataset)
dat <- dat %>% tibble::rownames_to_column('carnames') %>%
filter(cyl %in% c(input$select_cyl)) %>%
tibble::column_to_rownames('carnames')
selectInput("car","car",as.list(rownames(dat)))
})
# Check boxes
output$choose_columns <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$dataset))
return()
# Get the data set with the appropriate name
dat <- get(input$dataset)
colnames <- names(dat)
# Create the checkboxes and select them all by default
checkboxGroupInput("columns", "Choose columns",
choices = colnames,
selected = colnames)
})
output$radar <- renderChartJSRadar({
# Get the data set
dat <- get(input$dataset)
# dat <- mtcars
# Make sure columns are correct for data set (when data set changes, the
# columns will initially be for the previous data set)
if (is.null(input$columns) || !(input$columns %in% names(dat)))
return()
# Keep the selected columns
dat <- dat[, input$columns, drop = FALSE]
# dat <- dat %>% filter(cyl %in% c(input$select_cyl))
#reform data for plot
dat <- as.data.frame(t(dat), stringsAsFactors = FALSE)
dat$labs <- row.names(dat)
dat <- dat[, c('labs', input$car)]
chartJSRadar(dat)
})
}
shinyApp(ui, server)
EDIT:
ui = pageWithSidebar(
headerPanel("Car Comparison Radar"),
sidebarPanel(
#uiOutput("choose_dataset"),
uiOutput("choose_cyclinder"),
uiOutput("choose_car"),
uiOutput("choose_columns")
),
mainPanel(
chartJSRadarOutput('radar', height = '350px')
)
)
server = function(input, output) {
output$choose_cyclinder <- renderUI({
temp <- mtcars %>% group_by(cyl) %>% summarise(Counts = n())
cyl <- levels(as.factor(temp$cyl))
selectInput("select_cyl", "Choose a cylinder", as.list(cyl), selected=TRUE, multiple = FALSE)
})
# choose dataset but I want choose cyl
# output$choose_dataset <- renderUI({
# data_sets <- "mtcars"
# selectInput("dataset", "Data set", data_sets)
# })
# select a car
output$choose_car <- renderUI({
# dat <- get(mtcars)
dat <- mtcars
dat <- dat %>% tibble::rownames_to_column('carnames') %>%
filter(cyl %in% c(input$select_cyl)) %>%
tibble::column_to_rownames('carnames')
selectInput("car","car",as.list(rownames(dat)))
})
# Check boxes
output$choose_columns <- renderUI({
# If missing input, return to avoid error later in function
# if(is.null(input$dataset))
# return()
# Get the data set with the appropriate name
# dat <- get(input$dataset)
dat <- mtcars
colnames <- names(dat)
# Create the checkboxes and select them all by default
checkboxGroupInput("columns", "Choose columns",
choices = colnames,
selected = colnames)
})
output$radar <- renderChartJSRadar({
# Get the data set
#dat <- get(input$dataset)
dat <- mtcars
# Make sure columns are correct for data set (when data set changes, the
# columns will initially be for the previous data set)
if (is.null(input$columns) || !(input$columns %in% names(dat)))
return()
# Keep the selected columns
dat <- dat[, input$columns, drop = FALSE]
# dat <- dat %>% filter(cyl %in% c(input$select_cyl))
#reform data for plot
dat <- as.data.frame(t(dat), stringsAsFactors = FALSE)
dat$labs <- row.names(dat)
dat <- dat[, c('labs', input$car)]
chartJSRadar(dat)
})
}
shinyApp(ui, server)

Resources