I have a shiny app where I am trying to load the app with some standard values for the user to understand the template and then allow them to add /edit/delete rows. I am able to add rows without any issues so far. But the modify seems to be giving issues.So when I try to modify the frequency value for any selected row I can change the number in the text box but when I click on save it doesn't update. Also at times the values in impressions column are updated by the value of the selected rows channel name. See screenshot below. I tried to edit value for frequency for channel 2 and look at the value for impressions before and after.
Before edit
After edit
Also the delete doesnt seem to delete any selected rows. Could someone help me what might be wrong here.
server.r#####
library(shiny)
library(shinyjs)
## shinysky is to customize buttons
library(shinysky)
library(DT)
library(data.table)
library(lubridate)
library(shinyalert)
library(dplyr)
rm(list = ls())
useShinyalert()
shinyServer(function(input, output, session){
### interactive dataset
vals_trich<-reactiveValues()
vals_trich$Data<-data.frame(Partner = c("Channel 1", "Channel 2","Channel 3"),
Impressions = c(7727063, 4741286, 105585800),
TotalReach = c (0, 0, .0),
Frequency = c(2, 2.6, 3.7),
Assumptions = c (.41, .45, .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 %>% mutate(TotalReach = Impressions/Frequency,pcReach = (TotalReach/(input$inNumber/Assumptions)*100))
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("Editing Values"),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.r####
#
# 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"),
))