Related
I'm working on cancer data from TCGA.
Im new to shiny and creating web applications (learning it!!)
I'm working on a shiny tool to plot the volcanoplot using highcharter package.
sometimes I'm successfully able to plot the volcanoplot in the UI. but sometimes it fails to plot it and throws an error saying,
"An error has occurred!
could not find function "highchartOutput"
and one warning message is given for the error;
Listening on http://127.0.0.1:5335
Warning: Error in highchartOutput: could not find function "highchartOutput"
83: dots_list
82: div
81: tabPanel
I think there is some problem with the tabset panel.
is this error has anything to do with indentation? (wherever I adjust the brackets it works magically. not sure how it works for sometimes.)
I am attaching the UI and server files with this post.
code is attached for one type of comparison
UI file below:
library(shiny)
# Define UI for application
shinyUI(fluidPage(
# Application title
titlePanel("miR-Gyn-Explorer"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
## select the count matrix
selectInput("file", label = h3("Count Matrix"),
choices = list("Stage I - Normal" = list("TCGA-BRCA" = "Data/TCGA-BRCASI_NT.rda", "TCGA-UCEC" = "Data/TCGA-UCECSI_NT.rda"))),
## select the phenodata of samples
selectInput("phenofile", label = h3("Sample Phenodata"),
choices = list("Stage I - Normal" = list("TCGA-BRCA" = "Data/TCGA-BRCA_phenoSI_NT.rda", "TCGA-UCEC" = "Data/TCGA-UCEC_phenoSI_NT.rda"))),
submitButton("Update View")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("DEmiRNA", DT::dataTableOutput("DEmiRNA"),
"Volcano-Plot", highchartOutput("volcanoPlot", height = "500px"))
#tabPanel("miRNA-Targets", DT::dataTableOutput('miRTarget'),
#plotOutput("GO"))
)
)
)
)
)
server file:
library(shiny)
library(R.utils)
##function to find the DEmiRNA by edgeR method
library(limma)
library(edgeR)
library(DT)
library(dplyr)
library(multiMiR)
library(miRBaseConverter)
library(ggplot2)
#library(ggrepel)
library(tidyverse)
library(highcharter)
library(org.Hs.eg.db)
library(clusterProfiler)
library(purrr)
gdcDEmiRNA <- function(counts, groups, comparison, filter=TRUE) {
## method = edgeR
dge = DGEList(counts = counts, samples = groups)
group <- factor(groups$group)
design <- model.matrix(~0+group)
colnames(design) <- levels(group)
contrast.matrix <- makeContrasts(contrasts=comparison,
levels=design)
keep = filterByExpr(dge,design)
dge <- dge[keep,,keep.lib.sizes = TRUE]
dge <- calcNormFactors(dge)
dge <- estimateDisp(dge, design)
fit <- glmFit(dge, design)
lrt <- glmLRT(fit, contrast=contrast.matrix)
DEGAll <- lrt$table
DEGAll$FDR <- p.adjust(DEGAll$PValue, method = 'fdr')
o <- order(DEGAll$FDR)
DEGAll <- DEGAll[o,]
return (DEGAll)
}
# Define server logic required to perform the DEmiRNA analysis
server <- function(input, output) {
d <- reactive({
#DEmiRNA calculation
file <- load(input$file)
phenofile <- load(input$phenofile)
if(file == "SI_NT"){
if(phenofile == "phenoSI_NT"){
DEmiRNA <- gdcDEmiRNA(counts = SI_NT, groups = phenoSI_NT,
comparison = 'StageI-Normal')
}
}
})
output$DEmiRNA <- DT::renderDataTable({
mir <- d()
#mir <- mir[mir$FDR < input$FDR,]
})
output$volcanoPlot <- renderHighchart({
x <- d()
x$mirna <- rownames(x)
x$sig <- ifelse(x$PValue < 0.05 & abs(x$logFC) > 0.57, "DEmiRNA", "Not Regulated")
hc <- highchart() %>%
hc_add_series(x, "scatter", hcaes(logFC, -log10(PValue), group = sig, value = mirna),
color = c('rgba(67, 67, 72, 0.6)', 'rgba(124, 181, 236, 0.6)'),
enableMouseTracking = c(TRUE, TRUE),
showInLegend = TRUE, marker = list(radius = 4)) %>%
hc_tooltip(pointFormat = "{point.value}", headerFormat = "") %>%
hc_xAxis(title = list(text = "Log fold change"), gridLineWidth = 1,
tickLength = 0, startOnTick = "true", endOnTick = "true", min = -6, max = 6) %>%
hc_yAxis(title = list(text = "-Log10(p-value)")) %>%
hc_chart(zoomType = "xy", width=700) %>%
hc_exporting(enabled = TRUE, filename = "volcano")
hc
})
}
any comment and help from you guys is appreciated
Thank you in advance!
-Ankita
Why is this so difficult?! I have (what I believe is a factor vector) and I want to add an item to the list so I can use it farther down the road.
I want to add "memo.txt" to the factor vector filenames.
I have figured out how to add a factor level to the list, but not the item itself.
levels(filenames) <- c(levels(filenames), "memo.txt")
The specific section I am working in is here:
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
#I need to add items to "filenames" here. I then display "test" to make sure those items exist in "filenames" - ie, i want to add "memo.txt" to filenames.
output$test <- renderTable(filenames)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
The entire code:
library(shiny)
library(timevis)
library(lubridate)
library(dplyr)
library(jsonlite)
library(base64enc)
starthour <- 8
today <- as.character(Sys.Date())
todayzero <- paste(today, "00:00:00")
todayAM <- paste(today, "07:00:00")
todayPM <- paste(today, "18:00:00")
items <- data.frame(
category = c("Room", "IceBreaker", "Activity", "Break"),
group = c(1, 2, 3, 4),
className = c ("red_point", "blue_point", "green_point", "purple_point"),
content = c("Big Room", "Introductions", "Red Rover", "Lunch"),
length = c(480, 60, 120, 90),
file_name = c("Toolkit_placeholder.pdf", NA, "Placeholder.txt", "Toolkit_placeholder.pdf")
)
groups <- data.frame(id = items$group, content = items$category)
data <- items %>% mutate(
id = 1:4,
start = as.POSIXct(todayzero) + hours(starthour),
end = as.POSIXct(todayzero) + hours(starthour) + minutes(items$length)
)
js <- "
function downloadZIP(x){
var csv = Papa.unparse(x.table);
var URIs = x.URIs;
domtoimage.toPng(document.getElementById('appts'), {bgcolor: 'white'})
.then(function (dataUrl) {
var zip = new JSZip();
var idx = dataUrl.indexOf('base64,') + 'base64,'.length;
var content = dataUrl.substring(idx);
zip.file('timeline.png', content, {base64: true})
.file('timeline.csv', btoa(csv), {base64: true});
for(let i=0; i < URIs.length; ++i){
zip.file(URIs[i].filename, URIs[i].uri, {base64: true});
}
zip.generateAsync({type:'base64'}).then(function (b64) {
var link = document.createElement('a');
link.download = 'mytimeline.zip';
link.href = 'data:application/zip;base64,' + b64;
link.click();
});
});
}
$(document).on('shiny:connected', function(){
Shiny.addCustomMessageHandler('download', downloadZIP);
});"
ui <- fluidPage(
tags$head(
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/dom-to-image/2.6.0/dom-to-image.min.js"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jszip/3.5.0/jszip.min.js"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/PapaParse/5.2.0/papaparse.min.js"),
tags$script(HTML(js)),
tags$style(
HTML(
"
.red_point { border-color: red; border-width: 2px; }
.blue_point { border-color: blue; border-width: 2px; }
.green_point { border-color: green; border-width: 2px; }
.purple_point { border-color: purple; border-width: 2px; }
"
)
)
),
DT::dataTableOutput("tbl1"),
conditionalPanel(
condition = "typeof input.tbl1_rows_selected !== 'undefined' && input.tbl1_rows_selected.length > 1",
actionButton(class = "btn-success",
"button2",
"GENERATE TIMELINE")
),
conditionalPanel(
condition = "input.button2 > 0",
timevisOutput("appts"),
actionButton("download", "Download timeline", class = "btn-success"),
conditionalPanel(
condition = "input.download > 0",
tableOutput("test")
)
)
)
server <- function(input, output, session) {
output$tbl1 <- DT::renderDataTable({
data
},
caption = 'Select desired options and scroll down to continue.',
selection = 'multiple',
class = "display nowrap compact",
extensions = 'Scroller',
options = list(
dom = 'Bfrtip',
paging = FALSE,
columnDefs = list(list(visible = FALSE))
))
observeEvent(input$button2, {
row_data <- data[input$tbl1_rows_selected, ]
output$appts <- renderTimevis(timevis(
data = row_data,
groups = groups,
fit = TRUE,
options = list(
editable = TRUE,
multiselect = TRUE,
align = "center",
stack = TRUE,
start = todayAM,
end = todayPM,
showCurrentTime = FALSE,
showMajorLabels = FALSE
)
))
file_list <- as.data.frame(row_data$file_name)
})
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
#levels(filenames) <- c(levels(filenames), "memo.txt")
#test <- "memo.txt"
#browser()
#filenames <- append(filenames,test)
# levels(filenames) <- c(levels(filenames), "memo.txt")
output$test <- renderTable(filenames)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
}
shinyApp(ui, server)
EDIT w/answer(ish)
After trying (and failing) like so many others to deal with the factors, I wisened up and set my original "items" dataframe to stringAsFactors = FALSE
this is by far the easiest solution. From there the following works:
items <- data.frame(
category = c("Room", "IceBreaker", "Activity", "Break"),
group = c(1, 2, 3, 4),
className = c ("red_point", "blue_point", "green_point",
"purple_point"),
content = c("Big Room", "Introductions", "Red Rover", "Lunch"),
length = c(480, 60, 120, 90),
file_name = c("Toolkit_placeholder.pdf", NA, "Placeholder.txt",
"Toolkit_placeholder.pdf"), stringsAsFactors = FALSE
)
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
static_files <- "memo.txt"
filenames <- append(filenames,static_files)
output$test <- renderTable(filenames)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
Instead of trying to manipulate the factors, the simplest answer was to set stringsToFactors as FALSE. I am using R version 3.6, in R 4.0 that is now the default behavior.
I have updated the original question to include the answer.
Try this code:
observeEvent(input$download, {
filenames <- na.omit(data[input$tbl1_rows_selected, "file_name"])
## added the next seven lines; no other modifications to your code.
filez <- file.path(".", "www", filenames)
fnamez <- lapply(seq_along(filez), function(i){
list(filename = filenames[i])
})
f2namez <- list(fnamez,"memo.txt")
filenamez <- unlist(f2namez)
filenamez2 <- data.frame(filenamez)
output$test <- renderTable(filenamez2)
files <- file.path(".", "www", filenames)
URIs <- lapply(seq_along(files), function(i){
URI <- dataURI(file = files[i])
list(filename = filenames[i], uri = substr(URI, 14, nchar(URI)))
})
table <- fromJSON(toJSON(input$appts_data), simplifyDataFrame = FALSE)
session$sendCustomMessage(
"download",
list(table = table, URIs = URIs)
)
})
No other modification to the remaining part of your code. This gives the following output:
I'm trying to create and render an interactive formattable table in a shiny app.
Here is a sample dataframe:
tcharts <- data.frame(pgm = c(1,2,3,4,5,6,7,8),
horse = c("Cigar", "Funny Cide", "Animal Kingdom", "Blame", "Zenyatta", "New Years Day", "Northern Dancer", "Beautiful Pleasure"),
groundloss = c(55,70,85,42,90,45,53,50),
distanceRun = c(5050,5070,5085,5045,5090,5045,5053,5050),
ttl = c(50,70,85,42,90,45,53,50),
fps = c(52.3,51.8,51.9,52.0,53.6,52.9,53.7,53.1),
finishTime = c(52.3,51.8,51.9,52.0,53.6,52.9,53.7,53.1),
finish = c(4,7,1,2,5,6,3,8),
BL = c(0,1,2,6,2,9,6,8),
rnum = c(1,1,1,1,1,1,1,1),
sixteenth = c(330,330,330,330,330,330,330)
)
Working version
This version of the code, when list() is empty (use all variables in dataframe) produces a table as expected.
library(shiny)
library(formattable)
inputPanel(
selectInput("rnum", label = "Race Number:",
choices = c(1,2,3,4,5,6,7,8,9), selected = 1),
sliderInput("poc", label = "Point of Call:",
min = 330, max = 5280, value = 330, step = 330)
)
cdat <- reactive({
tcharts %>% filter(rnum %in% input$rnum) %>%
filter(Sixteenth %in% input$poc)
})
renderFormattable({
formattable(cdat(),list(
))
})
Error Version:
With this version, I get an ERROR: object pgm not found
library(shiny)
library(formattable)
inputPanel(
selectInput("rnum", label = "Race Number:",
choices = c(1,2,3,4,5,6,7,8,9), selected = 1),
sliderInput("poc", label = "Point of Call:",
min = 330, max = 5280, value = 330, step = 330)
)
cdat <- reactive({
tcharts %>% filter(rnum %in% input$rnum) %>%
filter(Sixteenth %in% input$poc)
})
renderFormattable({
formattable(cdat(),list(
pgm,
Horse
))
})
The error message leads me to believe I'm not specifying the variable correctly, but I'm not sure how to do it. I'v looked at several formattable / shiny SO questions and responses, but have not come up with the correct sytax.
I'm trying to generate a .xlsx file through the Openxlsx package with a reactive name and header inside file (the input variables are "ASL.1" and "Year.1"). The object to be saved in the file is the reactive table "tab_1 ()", that is generated by the app without any problems, but when I try to download it the name that is generated by the browser (Chrome) is not (i.e.) "Tab_1_TOSCANA_2015".xlsx" but "download_tab_1", the outputId of the button "download" associated, and nothing is generated. I do not understand where the problem is, since I checked other similar examples with Openxlsx and I do not see errors in my script; if I try to write a .csv file using the "write.csv" command everything works.
The script is here: https://drive.google.com/drive/folders/1dSI9qWgQyShjXjkJ2B6COuWzuWZie5IP?usp=sharing
The App (this is just a small part) is
https://cerimp-open-data.shinyapps.io/Malprof/
require(shiny)
require(dplyr)
require(reshape2)
require(stringr)
require(shinythemes)
require(ggplot2)
require(openxlsx)
require(leaflet)
require(RColorBrewer)
require(rgdal)
require(rgeos)
require(maptools)
load("dati.RData")
#### UI ####
ui <- fluidPage(
theme = shinytheme("spacelab"),
titlePanel("Indice"),
navlistPanel(
#### Tab I ####
tabPanel(title = "Tab. I Tassi per ASL di competenza e Sesso",
h1(textOutput(outputId = "tab_1_text"), style = "font-size:100%"),
fluidRow(column(3, selectInput(inputId = "ASL.1",
label = "Territorio",
choices = list("TOSCANA", "ASL CENTRO","ASL NORD-OVEST","ASL SUD-EST"),
selected = "Toscana",
multiple = FALSE)),
column(3, selectInput(inputId = "Anno.1",
label = "Anno di manifestazione",
choices = as.list(unique(malprof$Anno)),
selected = max(malprof$Anno),
multiple = FALSE))),
fluidRow(column(2, downloadButton(outputId = "download_tab_1",
label = "Scarica i dati"))),
div(tableOutput(outputId = "tab_1"), style = "font-size:80%")
),
#### Fig 1 ####
tabPanel(title = "Fig. 1 Andamento delle denunce INAIL e delle segnalazioni Malprof",
h1(textOutput(outputId = "fig_1_text"), style = "font-size:100%"),
fluidRow(column(3, selectInput(inputId = "ASL.fig.1",
label = "Territorio",
choices = list("TOSCANA", "ASL CENTRO","ASL NORD-OVEST","ASL SUD-EST"),
selected = "Toscana",
multiple = FALSE))),
div(plotOutput(outputId = "fig.1"), style = "font-size:80%")
)
)
#### SERVER ####
server <- function(input, output) {
fargs <- list(big.mark=".", decimal.mark=",") #parametri per la formattazione dei numeri nelle tabelle
annoUltimo <- max(malprof$Anno)
rg <- filter(malprof, ASL == "TOSCANA")
no <- filter(malprof, ASL == "ASL NORD-OVEST")
se <- filter(malprof, ASL == "ASL SUD-EST")
ce <- filter(malprof, ASL == "ASL CENTRO")
#### Tabella I - Distribuzione di frequenza delle segnalazioni di MP e dei relativi tassi per 100.000 abitanti suddivisi per ASL di competenza e Sesso ####
selezioneASL.1 <- reactive({switch(input$ASL.1,
"TOSCANA" = rg,
"ASL CENTRO" = ce,
"ASL NORD-OVEST" = no,
"ASL SUD-EST" = se)})
tab.1 <- reactive({
pop <- popTosc %>% filter(Anno == input$Anno.1) %>%
dcast(EXASL ~ SEX, drop = T, fill = 0, fun.aggregate = sum, value.var = "N") %>%
filter(!is.na(EXASL))
mp <- selezioneASL.1() %>% filter(Anno == input$Anno.1) %>%
dcast(EXASL ~ sesso_lav, drop = T, fill = 0, fun.aggregate = length, value.var = "Anno")
tab <- pop %>% inner_join(mp, by = c("EXASL" = "EXASL")) %>%
mutate(T_F = round((F.y/F.x)*100000, 1),
T_M = round((M.y/M.x)*100000, 1)) %>%
select(EXASL, F.x, M.x, F.y, M.y, T_F, T_M)
tab.tot <- c("TOTALE", sum(tab$F.x), sum(tab$M.x), sum(tab$F.y), sum(tab$M.y), round((sum(tab$F.y)/sum(tab$F.x))*100000, 1), round((sum(tab$M.y)/sum(tab$M.x))*100000, 1))
tab <- rbind(tab, tab.tot)
tab$F.x <- as.numeric(tab$F.x)
tab$M.x <- as.numeric(tab$M.x)
tab$F.y <- as.numeric(tab$F.y)
tab$M.y <- as.numeric(tab$M.y)
tab$T_F <- as.character(tab$T_F)
tab$T_M <- as.character(tab$T_M)
tab <- rename(tab, "EXASL" = EXASL, "Pop. F" = F.x, "Pop. M" = M.x, "Segn. F" = F.y, "Segn. M" = M.y, "Tasso - F" = T_F, "Tasso - M" = T_M)
tab
})
output$tab_1_text <- renderText(paste0("Distribuzione di frequenza delle segnalazioni di MP e dei relativi tassi per 100.000 abitanti suddivisi per ASL di competenza e Sesso - ", input$ASL.1, ", ", input$Anno.1, "."))
output$tab_1 <- renderTable({tab.1()},
display=c("s","s","d","d","d","d","s","s"),
spacing="s",
align = 'lcccccc',
na="--", format.args=fargs)
output$download_tab_1 <- downloadHandler(
filename = function() {
paste("Tab_1_", input$ASL.1, "_", input$Anno.1, ".xlsx", sep = "")
},
content = function(file) {
wb <- createWorkbook()
addWorksheet(wb, sheetName = "Dati", gridLines = TRUE)
intestazione <- paste0("Distribuzione di frequenza delle segnalazioni di MP e dei relativi tassi per 100.000 abitanti suddivisi per ASL di competenza e Sesso - ", input$ASL.1, ", ", input$Anno.1, ".")
writeData(wb, 1, x = intestazione)
writeDataTable(wb, sheet = 1, startRow = 3, x = tab.1(), colNames = TRUE)
saveWorkbook(wb, file)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
I have been working through what sounds like the same problem. It was caused by a problem the openxlsx package being accessed by the downloadHandler (Shiny). No amount of fixing permissions or ensuring the package was in the correct folder worked. As far as we could figure out its a problem with the Shiny download handler interacting with openxlsx.
In the end I fixed this by saving a local version temp of the XLSX and then referencing this in the downloadHandler.
Move this section (inside the downloadHandler) to outside of the download handler:
addWorksheet(wb, sheetName = "Dati", gridLines = TRUE)
intestazione <- paste0("Distribuzione di frequenza delle segnalazioni di MP e dei relativi tassi per 100.000 abitanti suddivisi per ASL di competenza e Sesso - ", input$ASL.1, ", ", input$Anno.1, ".")
writeData(wb, 1, x = intestazione)
writeDataTable(wb, sheet = 1, startRow = 3, x = tab.1(), colNames = TRUE)
saveWorkbook(wb, file)
Then inside the handler use a version of this:
output$downloadData <- downloadHandler(
filename = function(){paste0(intestazione,".xlsx")},
content = function(file) {
file.copy(filename,file)
#file.rename(fname,file)
}
)
I think I get it working by simply referencing file in the saveWorkbook function inside the download handler...
This is working with openxlsx package and Shiny downloadHandler :
output$quick_export <- downloadHandler(
filename = "my export.xlsx",
content = function(file) {
wb <- createWorkbook()
addWorksheet(wb, "Cars")
x <- mtcars[1:6, ]
writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE)
saveWorkbook(wb, file, overwrite = TRUE)
}
)
I have a handsontable with dynamic data and I am uploading it to the MSSQL DB with the sqlSave code with the Submit button in shiny.
However, I could bot find any function that will going to disable the actionbutton for lets say 10 seconds. I tried shinyjs::disable and withProgress, incProgress things but none of them worked.
Thank you,
dbhandle <- odbcDriverConnect('driver={SQL Server};server=....;database=...;trusted_connection=true')
withProgress(
sqlSave(dbhandle, dat = some data),
tablename = "Budget_Tool",
rownames = F, append = T, verbose = T, fast = F, colnames = F, safer =
T), value = 1,
style = "notification", message = "Submitting, please wait..")
--------------------
actionButton("submit", "Submit", class = "btn-primary",
style="color: #fff; background-color: #337ab7; border-
color: #2e6da4; font-size: 20px;"),
It's more or less straight forward when you integrate the disabling and enabling before and after the action function.
Here is a sample snippet:
library(shiny)
library(shinyjs)
ui <- shinyUI({
shiny::fluidPage(
useShinyjs(), # Set up shinyjs
actionButton(inputId = "start", label = "start")
)
})
server <- shinyServer(function(input, output){
actionFunction = function(){
shinyjs::disable("start")
# Replace actual code instead
withProgress(message = 'Calculation in progress',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
})
shinyjs::enable("start")
}
# Run action function on button click
onclick("start", actionFunction())
})
shinyApp(ui,server)
I fixed it by using hide and show;
observeEvent(input$submit, {
hide('submit', animType = "fade", time = 5)
asd <- as.data.frame(cbind(Department = rv$data[,2], Cost_Summary_Key =
rv$data[,1], Calculated_Budget = rowSums(rv$data[,3:14]))) %>%
left_join(CSK_Budget, c("Department", "Cost_Summary_Key"))
asd <- asd %>% mutate(Deviation = (as.numeric(Budget_2017) - rowSums(rv$data[,3:14])))
x <- c()
for (i in 1:nrow(asd)) {
if(asd[i,5] >= -0.05)
{x[i] <- TRUE} else {x[i] <- FALSE}
}
moment <- substr(Sys.time(), 1, 10)
moment2 <- substr(Sys.time(), 12, 19)
personel <- input$userName
if( all(x))
{
dbhandle <- odbcDriverConnect('driver={SQL Server};server=...;database=...._SQL;trusted_connection=true')
withProgress(
sqlSave(dbhandle, dat = (cbind(melt(rv$data, na.rm = F, varnames = c(Department, Cost_Summary_Key), as.is = F), Year = "2017",
Time_Stamp1 = moment, Time_Stamp2 = moment2, User = personel)),
tablename = ".....",
rownames = F, append = T, verbose = T, fast = F, colnames = F, safer = T), value = 1,
style = "notification", message = "Submitting, please wait..")
js_string <- 'alert("Succes!!");'
session$sendCustomMessage(type='jsCode', list(value = js_string))
showNotification("Thanks, your response was submitted successfully!", duration = 5, type = "warning")
}
else {showNotification("Check Your Budget Items !!", duration = 3, type = "warning")}
odbcCloseAll()
show('submit', animType = "slide", time = 1)
})