Update values in R shiny DT when click on saved button - r

Question

So I am trying to make a shiny app that acts as a calculator. So the basic idea is built on the DT edit function which I found here. As you can see the screenshot below once the user clicks on the save button I would like to update the values for the column TotalReach which is nothing but impressions/frequency. I was trying to do it under input$Updated_trich. But when I do it I get this error Warning: Error in function_list[[k]]: attempt to apply non-function.
What could I be doing to fix this. Below is the code
server
library(shiny)
library(shinyjs)
## shinysky is to customize buttons
library(shinysky)
library(DT)
library(data.table)
library(lubridate)
library(shinyalert)
rm(list = ls())
useShinyalert()
shinyServer(function(input, output, session){
### interactive dataset
vals_trich<-reactiveValues()
vals_trich$Data<-data.frame(Partner = c("Brand1", "Brand2","Brand3"),
Impressions = c(2000, 3000, 4000),
TotalReach = c (0, 0, .0),
Frequency = c(2, 3, 4),
Assumptions = c (.5, .5, .5),
pcReach = c (0, 0, 0),
#gg = c (.5, .5, .5),
stringsAsFactors = FALSE)
#vals_trich$Data<-readRDS("note.rds")
#### MainBody_trich is the id of DT table
output$MainBody_trich<-renderUI({
fluidPage(
hr(),
column(6,offset = 6,
HTML('<div class="btn-group" role="group" aria-label="Basic example" style = "padding:10px">'),
### tags$head() This is to change the color of "Add a new row" button
tags$head(tags$style(".butt2{background-color:#231651;} .butt2{color: #e6ebef;}")),
div(style="display:inline-block;width:30%;text-align: center;",actionButton(inputId = "Add_row_head",label = "Add", class="butt2") ),
tags$head(tags$style(".butt4{background-color:#4d1566;} .butt4{color: #e6ebef;}")),
div(style="display:inline-block;width:30%;text-align: center;",actionButton(inputId = "mod_row_head",label = "Edit", class="butt4") ),
tags$head(tags$style(".butt3{background-color:#590b25;} .butt3{color: #e6ebef;}")),
div(style="display:inline-block;width:30%;text-align: center;",actionButton(inputId = "Del_row_head",label = "Delete", class="butt3") ),
### Optional: a html button
# HTML('<input type="submit" name="Add_row_head" value="Add">'),
HTML('</div>') ),
column(12,dataTableOutput("Main_table_trich")),
tags$script("$(document).on('click', '#Main_table_trich button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random()) });")
)
})
#### render DataTable part ####
output$Main_table_trich<-renderDataTable({
DT=vals_trich$Data
datatable(DT,selection = 'single',
escape=F) })
observeEvent(input$Add_row_head, {
### This is the pop up board for input a new row
showModal(modalDialog(title = "Add a new row",
textInput(paste0("partner", input$Add_row_head), "Partner"),
numericInput(paste0("impressions", input$Add_row_head), "Impressions",0),
numericInput(paste0("reach", input$Add_row_head), "TotalReach:",0),
numericInput(paste0("frequency", input$Add_row_head), "Frequency:",0),
numericInput(paste0("assumption", input$Add_row_head), "Assumptions:",0),
numericInput(paste0("reach_pc", input$Add_row_head), "pcReach:",0),
actionButton("go", "Add item"),
easyClose = TRUE, footer = NULL ))
})
### Add a new row to DT
observeEvent(input$go, {
new_row=data.frame(
Partner=input[[paste0("partner", input$Add_row_head)]],
Impressions=input[[paste0("impressions", input$Add_row_head)]],
TotalReach=input[[paste0("reach", input$Add_row_head)]],
Frequency=input[[paste0("frequency", input$Add_row_head)]],
Assumptions=input[[paste0("assumption", input$Add_row_head)]],
pcReach=input[[paste0("reach_pc", input$Add_row_head)]]
)
vals_trich$Data<-rbind(vals_trich$Data,new_row )
removeModal()
})
observe({
# We'll use these multiple times, so use short var names for
# convenience.
c_num <- input$control_num
# Change the value
updateNumericInput(session, "inNumber", value = c_num)
})
### save to RDS part
observeEvent(input$Updated_trich,{
print(vals_trich$Data)
calc<- vals_trich$Data
print(calc)
calc <-calc %>% (calc$TotalReach = calc$Impressions/calc$Frequency)
print(calc)
vals_trich$Data <-calc
DT=vals_trich$Data
datatable(DT,selection = 'single',
escape=F)
saveRDS(vals_trich$Data, "op.rds")
shinyalert(title = "Saved!", type = "success")
})
### delete selected rows part
### this is warning messge for deleting
observeEvent(input$Del_row_head,{
showModal(
if(length(input$Main_table_trich_rows_selected)>=1 ){
modalDialog(
title = "Warning",
paste("Are you sure delete",length(input$Main_table_trich_rows_selected),"rows?" ),
footer = tagList(
modalButton("Cancel"),
actionButton("ok", "Yes")
), easyClose = TRUE)
}else{
modalDialog(
title = "Warning",
paste("Please select row(s) that you want to delect!" ),easyClose = TRUE
)
}
)
})
### If user say OK, then delete the selected rows
observeEvent(input$ok, {
vals_trich$Data=vals_trich$Data[-input$Main_table_trich_rows_selected]
removeModal()
})
### edit button
observeEvent(input$mod_row_head,{
showModal(
if(length(input$Main_table_trich_rows_selected)>=1 ){
modalDialog(
fluidPage(
h3(strong("Modification"),align="center"),
hr(),
dataTableOutput('row_modif'),
actionButton("save_changes","Save changes"),
tags$script(HTML("$(document).on('click', '#save_changes', function () {
var list_value=[]
for (i = 0; i < $( '.new_input' ).length; i++)
{
list_value.push($( '.new_input' )[i].value)
}
Shiny.onInputChange('newValue', list_value) });")) ), size="l" )
}else{
modalDialog(
title = "Warning",
paste("Please select the row that you want to edit!" ),easyClose = TRUE
)
}
)
})
#### modify part
output$row_modif<-renderDataTable({
selected_row=input$Main_table_trich_rows_selected
old_row=vals_trich$Data[selected_row]
row_change=list()
for (i in colnames(old_row))
{
if (is.numeric(vals_trich$Data[[i]]))
{
row_change[[i]]<-paste0('<input class="new_input" value= ','"',old_row[[i]],'"',' type="number" id=new_',i,' ><br>')
}
else if( is.Date(vals_trich$Data[[i]])){
row_change[[i]]<-paste0('<input class="new_input" value= ','"',old_row[[i]],'"',' type="date" id=new_ ',i,' ><br>')
}
else
row_change[[i]]<-paste0('<input class="new_input" value= ','"',old_row[[i]],'"',' type="textarea" id=new_',i,'><br>')
}
row_change=as.data.table(row_change)
setnames(row_change,colnames(old_row))
DT=row_change
DT
},escape=F,options=list(dom='t',ordering=F,scrollX = TRUE),selection="none" )
### This is to replace the modified row to existing row
observeEvent(input$newValue,
{
newValue=lapply(input$newValue, function(col) {
if (suppressWarnings(all(!is.na(as.numeric(as.character(col)))))) {
as.numeric(as.character(col))
} else {
col
}
})
DF=data.frame(lapply(newValue, function(x) t(data.frame(x))))
colnames(DF)=colnames(vals_trich$Data)
vals_trich$Data[input$Main_table_trich_rows_selected]<-DF
}
)
### This is nothing related to DT Editor but I think it is nice to have a download function in the Shiny so user
### can download the table in csv
output$Trich_csv<- downloadHandler(
filename = function() {
paste("Trich Project-Progress", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(data.frame(vals_trich$Data), file, row.names = F)
}
)
})
ui
#
# This is the user-interface definition of a Shiny web application. You can
# run the application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(shinyjs)
library(shinysky)
library(DT)
library(data.table)
library(lubridate)
library(shinyalert)
useShinyalert()
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Calculator"),
### This is to adjust the width of pop up "showmodal()" for DT modify table
tags$head(tags$style(HTML('
.modal-lg {
width: 1200px;
}
'))),
# helpText("Note: Remember to save any updates!"),
br(),
### tags$head() is to customize the download button
numericInput("inNumber", "Number input:",
min = 1, max = 330000000, value = 20000000, step = 1000000),
useShinyalert(), # Set up shinyalert
uiOutput("MainBody_trich"),actionButton(inputId = "Updated_trich",label = "Save"),
tags$head(tags$style(".butt{background-color:#230682;} .butt{color: #e6ebef;}")),br(),
downloadButton("Trich_csv", "Download in CSV", class="butt"),
))

Answer 1

The error appears to stem from the usage of piping in this line:
calc <-calc %>% (calc$TotalReach = calc$Impressions/calc$Frequency)
Adding library(dplyr)
to the attached libraries and changing the line to
calc <-calc %>%
mutate(TotalReach = Impressions/Frequency)
allows proper saving to occur.