26 changed files with 1458 additions and 0 deletions
@ -0,0 +1,4 @@ |
|||
.Rproj.user |
|||
.Rhistory |
|||
.RData |
|||
.Ruserdata |
|||
@ -0,0 +1,212 @@ |
|||
--- |
|||
title: "Pre" |
|||
author: "Scary Scarecrow" |
|||
date: '2022-06-27' |
|||
output: html_document |
|||
--- |
|||
|
|||
```{r setup, include=FALSE} |
|||
knitr::opts_chunk$set(echo = TRUE) |
|||
library(dplyr) |
|||
library(echarts4r) |
|||
library(lubridate) |
|||
library(shinymanager) |
|||
``` |
|||
|
|||
## Credentials |
|||
|
|||
```{r} |
|||
credentials <- data.frame( |
|||
user = c("shiny", "asitav", "rigo", "aldo"), |
|||
password = c("lanubia@2021", "lanubia@2021","lanubia@2021","lanubia@2021"), |
|||
admin = c(FALSE, TRUE, FALSE, FALSE), |
|||
email = c("hello@asitavsen.com","asitav.sen@lanubia.com","rigo.selassa@lanubia.com","aldo.silvano@lanubia.com"), |
|||
stringsAsFactors = FALSE |
|||
) |
|||
|
|||
create_db( |
|||
credentials_data = credentials, |
|||
sqlite_path = "./cred.sqlite", # will be created |
|||
passphrase = "kJuyhG657Hj&^%gshj*762hjsknh&662" |
|||
) |
|||
``` |
|||
|
|||
|
|||
## DB |
|||
|
|||
```{r} |
|||
connec <- dbConnect( |
|||
RPostgres::Postgres(), |
|||
dbname = dsn_database, |
|||
host = dsn_hostname, |
|||
port = dsn_port, |
|||
user = dsn_uid, |
|||
password = dsn_pwd |
|||
) |
|||
``` |
|||
|
|||
|
|||
|
|||
```{r} |
|||
#dat<-read.csv("./data/initial.csv") |
|||
#lims<-read.csv("./data/dev.limits.csv") |
|||
dat.1<- |
|||
dat |> |
|||
mutate(devia=Actual-Plan) |> |
|||
mutate(devia.per=round(devia/Plan,2)) |
|||
#dbCreateTable(connec, "calculated", dat.1) |
|||
dbWriteTable(connec, "calculated", dat.1, append=TRUE) |
|||
dbWriteTable(connec, "limits", lims, append=TRUE) |
|||
|
|||
#dbRemoveTable(connec,"calculated") |
|||
dat<-dbGetQuery( |
|||
connec, |
|||
'SELECT * FROM calculated' |
|||
) |
|||
|
|||
lims<-dbGetQuery( |
|||
connec, |
|||
'SELECT * FROM limits' |
|||
) |
|||
|
|||
#dbReadTable(connec, "calculated") |
|||
|
|||
exp<- |
|||
dat |> |
|||
inner_join(lims, by=c("GL.account")) |> |
|||
mutate(act.req=ifelse(devia.per>Limit & devia > 500,T,F)) |> |
|||
filter(act.req) |> |
|||
select(1:3) |> |
|||
mutate(explanation=c("Cyberattack","Overwork","Interview","Maintenance","Quarterly Report","New Legislation")) |
|||
|
|||
dbWriteTable(connec, "explanations", exp, append=TRUE) |
|||
exp<-dbGetQuery( |
|||
connec, |
|||
'SELECT * FROM explanations' |
|||
) |
|||
|
|||
approvals<- exp |> mutate(approved=F) |
|||
|
|||
dbWriteTable(connec, "approvals", approvals, overwrite=T) |
|||
|
|||
approvals<-dbGetQuery( |
|||
connec, |
|||
'SELECT * FROM approvals' |
|||
) |
|||
|
|||
|
|||
dat |> |
|||
inner_join(lims, by=c("GL.account")) |> |
|||
mutate(act.req=ifelse(devia.per>Limit & devia > 500,T,F)) |> |
|||
filter(act.req) |> |
|||
left_join(exp, by=c("month"="month","Cost.center"="Cost.center","GL.account"="GL.account")) |
|||
|
|||
|
|||
emailsids<-dat |> |
|||
select(Cost.center, GL.account) |> |
|||
distinct() |> |
|||
mutate(email=c("asitav.sen@lanubia.com")) |
|||
dbWriteTable(connec, "emails", emailsids, overwrite=T) |
|||
emailsids<-dbGetQuery( |
|||
connec, |
|||
'SELECT * FROM emails' |
|||
) |
|||
|
|||
sel.emails<- emailsids |> |
|||
filter(email=="asitav.sen@lanubia.com") |
|||
|
|||
dat |> |
|||
inner_join(lims, by=c("GL.account")) |> |
|||
mutate(act.req=ifelse(devia.per>Limit & devia > 500,T,F)) |> |
|||
filter(act.req) |> |
|||
left_join(sel.emails, by=c("Cost.center"="Cost.center","GL.account"="GL.account")) |> |
|||
left_join(exp, by=c("month"="month","Cost.center"="Cost.center","GL.account"="GL.account")) |> |
|||
filter(is.na(explanation) | explanation=="") |> |
|||
filter(email=="asitav.sen@lanubia.com") |> |
|||
select(-c(9,10)) |
|||
|
|||
exp |
|||
``` |
|||
|
|||
|
|||
|
|||
```{r} |
|||
|
|||
dat.2<- |
|||
dat |> |
|||
mutate(month=ym(month)) |> |
|||
group_by(month) |> |
|||
summarise(Plan=sum(Plan),Actual=sum(Actual)) |> |
|||
mutate(devia=Actual-Plan) |> |
|||
mutate(deviation.percent=round(devia*100/Plan,2)) |
|||
|
|||
e_chart(dat.2, x=month) |> |
|||
e_line(serie = deviation.percent, smooth=T, color="cyan") |> |
|||
e_area(serie = deviation.percent, smooth=T, color="gray") |> |
|||
e_axis_labels(x = "month", y="Deviation") |> |
|||
e_format_y_axis(suffix = " %") |> |
|||
e_title("Deviation", "Selected Cost Centers") |> |
|||
e_tooltip() |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = c(0, 1)) |> |
|||
e_toolbox_feature(feature = c("saveAsImage","dataView")) |> |
|||
e_theme("chalk") |
|||
|
|||
history<-dat.2 |> select(month,deviation.percent) |> rename(ds=month, y=deviation.percent) |
|||
model <- prophet::prophet(history) |
|||
future <- prophet::make_future_dataframe(model, periods = 2) |
|||
forecast <- predict(model, future) |
|||
|
|||
dat |> |
|||
filter(month==max(month)) |> |
|||
mutate(cost_gl=paste0(Cost.center,"_",GL.account)) |> |
|||
group_by(cost_gl) |> |
|||
summarise(Plan=sum(Plan),Actual=sum(Actual)) |> |
|||
mutate(devia=Actual-Plan) |> |
|||
mutate(deviation.percent=round(devia*100/Plan,2)) |> |
|||
arrange(desc(deviation.percent)) |> |
|||
e_charts(cost_gl) |> |
|||
e_bar(Plan, name = "Plan", color="gray") |> |
|||
e_step(Actual, name = "Actual", color="red") |> |
|||
e_axis_labels(x = "GL+Cost Center", y="Deviation") |> |
|||
e_title("Selected Cost Centers") |> |
|||
e_tooltip() |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = 0, type = "slider") |> |
|||
e_datazoom(y_index = 0, type = "slider") |> |
|||
e_toolbox_feature(feature = c("saveAsImage","dataView")) |> |
|||
e_theme("chalk") |
|||
``` |
|||
```{r} |
|||
unique(dat$Cost.center) |> saveRDS("./data/costcenters.RDS") |
|||
unique(dat$GL.account) |> saveRDS("./data/glaccounts.RDS") |
|||
unique(dat$month) |> saveRDS("./data/months.RDS") |
|||
lims |
|||
``` |
|||
|
|||
|
|||
|
|||
|
|||
|
|||
```{r} |
|||
dat.dev<-dat |> |
|||
filter(devia>0) |> |
|||
select(2,3,6) |
|||
|
|||
e_charts(dat.dev) |> |
|||
e_pie(devia) |
|||
|
|||
blastula::create_smtp_creds_file( |
|||
file = "email_creds", |
|||
user = "apikey", |
|||
host = "smtp.sendgrid.net", |
|||
port = 465, |
|||
use_ssl = TRUE |
|||
) |
|||
|
|||
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 |
|||
``` |
|||
|
|||
|
|||
|
|||
|
|||
@ -0,0 +1,13 @@ |
|||
Version: 1.0 |
|||
|
|||
RestoreWorkspace: Default |
|||
SaveWorkspace: Default |
|||
AlwaysSaveHistory: Default |
|||
|
|||
EnableCodeIndexing: Yes |
|||
UseSpacesForTab: Yes |
|||
NumSpacesForTab: 2 |
|||
Encoding: UTF-8 |
|||
|
|||
RnwWeave: Sweave |
|||
LaTeX: pdfLaTeX |
|||
Binary file not shown.
|
|
|
Binary file not shown.
|
@ -0,0 +1 @@ |
|||
{"type":"list","attributes":{"names":{"type":"character","attributes":{},"value":["version","host","port","use_ssl","user","password"]}},"value":[{"type":"integer","attributes":{},"value":[1]},{"type":"character","attributes":{},"value":["smtp.sendgrid.net"]},{"type":"double","attributes":{},"value":[465]},{"type":"logical","attributes":{},"value":[true]},{"type":"character","attributes":{},"value":["apikey"]},{"type":"character","attributes":{},"value":["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"]}]} |
|||
Binary file not shown.
|
|
Binary file not shown.
Binary file not shown.
@ -0,0 +1 @@ |
|||
{"type":"list","attributes":{"names":{"type":"character","attributes":{},"value":["version","host","port","use_ssl","user","password"]}},"value":[{"type":"integer","attributes":{},"value":[1]},{"type":"character","attributes":{},"value":["smtp.sendgrid.net"]},{"type":"double","attributes":{},"value":[465]},{"type":"logical","attributes":{},"value":[true]},{"type":"character","attributes":{},"value":["apikey"]},{"type":"character","attributes":{},"value":["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"]}]} |
|||
@ -0,0 +1,87 @@ |
|||
|
|||
|
|||
|
|||
# Database details |
|||
|
|||
|
|||
dsn_database <- "postgres" |
|||
|
|||
dsn_hostname <- "localhost" |
|||
|
|||
dsn_port <- "5432" |
|||
|
|||
dsn_uid <- "postgres" |
|||
|
|||
dsn_pwd <- "julley09" |
|||
|
|||
|
|||
|
|||
|
|||
# Read Cost Center etc. list from data (Changes, modification needs creating the file again and redeploying the app) |
|||
|
|||
cost.centers <- readRDS("./data/costcenters.RDS") |
|||
glaccounts <- readRDS("./data/glaccounts.RDS") |
|||
mont <- readRDS("./data/months.RDS") |
|||
|
|||
# Email settings |
|||
|
|||
# smtp <- server( |
|||
# host = "smtp.sendgrid.net", |
|||
# port = 465, |
|||
# username = "apikey", |
|||
# password = "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" |
|||
# ) |
|||
|
|||
|
|||
# Function to get data from DB |
|||
|
|||
get.db.data <- function(qry = 'SELECT * FROM calculated') { |
|||
dbGetQuery(connec, |
|||
qry) |
|||
} |
|||
|
|||
# Function to aggregate monthly deviation |
|||
|
|||
mon.dev <- function(dat) { |
|||
dat |> |
|||
mutate(month = ym(month)) |> |
|||
group_by(month) |> |
|||
summarise(Plan = sum(Plan), Actual = sum(Actual)) |> |
|||
mutate(devia = Actual - Plan) |> |
|||
mutate(deviation.percent = round(devia * 100 / Plan, 2)) |
|||
} |
|||
|
|||
# Function to aggregate last month by gl and cost |
|||
|
|||
last.mon <- function(dat) { |
|||
dat |> |
|||
filter(month == max(month)) |> |
|||
mutate(cost_gl = paste0(Cost.center, "_", GL.account)) |> |
|||
group_by(cost_gl) |> |
|||
summarise(Plan = sum(Plan), Actual = sum(Actual)) |> |
|||
mutate(devia = Actual - Plan) |> |
|||
mutate(deviation.percent = round(devia * 100 / Plan, 2)) |> |
|||
arrange(desc(deviation.percent)) |
|||
} |
|||
|
|||
|
|||
admin.menu <- sidebarMenu( |
|||
id = "m", |
|||
menuItem("Dashboard", tabName = "dashboard", icon = icon("chart-line")), |
|||
menuItem("Upload", icon = icon("upload"), tabName = "upload"), |
|||
menuItem("Approvals", icon = icon("check"), tabName = "approvals"), |
|||
menuItem("Explanations", icon = icon("file"), tabName = "explanations"), |
|||
menuItem("Admin", icon = icon("toolbox"), tabName = "admin"), |
|||
menuItem("Contact us", icon = icon("at"), href = "https://lanubia.com/contact/") |
|||
) |
|||
|
|||
other.menu <- sidebarMenu( |
|||
id = "m", |
|||
menuItem( |
|||
"Dashboard", |
|||
tabName = "dashboard", |
|||
icon = icon("dashboard") |
|||
), |
|||
menuItem("Explanations", icon = icon("th"), tabName = "explanations"), |
|||
menuItem("Contact us", icon = icon("id-card"), href = "https://lanubia.com/contact/") |
|||
) |
|||
@ -0,0 +1,169 @@ |
|||
|
|||
dashboard<- tabItem( |
|||
tabName = "dashboard", |
|||
autoWaiter(), |
|||
fluidRow( |
|||
column( |
|||
width = 4, |
|||
"Filter Cost Center and GL Accounts" |
|||
), |
|||
column( |
|||
width = 4, |
|||
pickerInput( |
|||
"glaccount", |
|||
choices = glaccounts, |
|||
selected = glaccounts, |
|||
options = list( |
|||
`actions-box` = TRUE), |
|||
multiple = TRUE |
|||
) |
|||
), |
|||
column( |
|||
width = 4, |
|||
pickerInput( |
|||
"costcenter", |
|||
choices = cost.centers, # Getting the list from reading data from local. See helper_server |
|||
selected = cost.centers, |
|||
options = list( |
|||
`actions-box` = TRUE), |
|||
multiple = TRUE |
|||
) |
|||
) |
|||
), |
|||
fluidRow( |
|||
valueUI("variation"), |
|||
valueUI("variabs"), |
|||
valueUI("actexpe"), |
|||
), |
|||
fluidRow( |
|||
shinydashboardPlus::box( |
|||
title = "Deviation % by Month", |
|||
collapsible = TRUE, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
echarts4rOutput("monthlypervar",height = "300px") |
|||
), |
|||
shinydashboardPlus::box( |
|||
title = "Abs. Deviation by Month", |
|||
collapsible = TRUE, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
echarts4rOutput("monthlyabsvar",height = "300px") |
|||
) |
|||
), |
|||
fluidRow( |
|||
shinydashboardPlus::box( |
|||
title = "Plan vs Actual", |
|||
collapsible = TRUE, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
sidebar = boxSidebar( |
|||
startOpen = FALSE, |
|||
id = "monthselector", |
|||
pickerInput( |
|||
"mont", |
|||
choices = mont, |
|||
selected = max(mont) |
|||
) |
|||
), |
|||
echarts4rOutput("monthlyabs",height = "300px") |
|||
) |
|||
) |
|||
) |
|||
|
|||
upload<- tabItem( |
|||
tabName = "upload", |
|||
autoWaiter(), |
|||
fluidRow( |
|||
|
|||
shinydashboardPlus::box( |
|||
title = "Fresh Upload", |
|||
collapsible = TRUE, |
|||
width = 12, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
fileInput( |
|||
"inpfile", |
|||
"Upload the file", |
|||
multiple = FALSE, |
|||
accept = ".csv", |
|||
width = NULL, |
|||
buttonLabel = "Browse...", |
|||
placeholder = "No file selected" |
|||
), |
|||
datatableUI("freshdat"), |
|||
actionBttn("datsubmit","Submit") |
|||
) |
|||
) |
|||
) |
|||
|
|||
appndev <- tabItem( |
|||
tabName = "approvals", |
|||
autoWaiter(), |
|||
shinydashboardPlus::box( |
|||
title = "Deviations without explanation", |
|||
collapsible = TRUE, |
|||
width = 12, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
sidebar = boxSidebar( |
|||
startOpen = FALSE, |
|||
id = "limitselector", |
|||
sliderInput("limittoignore","Define limit", min=100, max=2000, step=100, value = 500) |
|||
), |
|||
datatableUI("devnoexp"), |
|||
actionBttn("notify","Notify") |
|||
), |
|||
shinydashboardPlus::box( |
|||
title = "Awaiting Approval", |
|||
collapsible = TRUE, |
|||
width = 12, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
excelOutput("expnoapp"), |
|||
actionBttn("approvalsubmit","Submit") |
|||
) |
|||
|
|||
) |
|||
|
|||
explan <- tabItem( |
|||
tabName = "explanations", |
|||
autoWaiter(), |
|||
shinydashboardPlus::box( |
|||
title = "Explanations Pending", |
|||
collapsible = TRUE, |
|||
width = 12, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
excelOutput("explanationtofill"), |
|||
actionBttn("explanationsubmit","Submit") |
|||
) |
|||
|
|||
|
|||
) |
|||
|
|||
admin<-tabItem( |
|||
tabName = "admin", |
|||
autoWaiter(), |
|||
shinydashboardPlus::box( |
|||
title = "Email IDs", |
|||
width = 8, |
|||
collapsible = TRUE, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
excelOutput("emailtable"), |
|||
actionBttn("emailsubmit","Submit") |
|||
), |
|||
shinydashboardPlus::box( |
|||
title = "Deviation Rules", |
|||
width = 4, |
|||
collapsible = TRUE, |
|||
status = "navy", |
|||
solidHeader = TRUE, |
|||
excelOutput("limitable"), |
|||
actionBttn("limitsubmit","Submit") |
|||
) |
|||
|
|||
) |
|||
|
|||
|
|||
@ -0,0 +1,29 @@ |
|||
datatableUI<- function(id){ |
|||
ns<-NS(id) |
|||
DT::dataTableOutput(ns("dtable")) |
|||
} |
|||
|
|||
datatableServer<-function(id, dat){ |
|||
moduleServer( |
|||
id, |
|||
function(input,output,session){ |
|||
output$dtable<- renderDataTable({ |
|||
validate(need(nrow(dat())>0, "No data")) |
|||
datatable( |
|||
dat(), |
|||
extensions = "Buttons", |
|||
options = list( |
|||
paging = TRUE, |
|||
scrollX = TRUE, |
|||
searching = TRUE, |
|||
ordering = TRUE, |
|||
dom = 'Bfrtip', |
|||
buttons = c('copy', 'csv', 'excel', 'pdf'), |
|||
pageLength = 10, |
|||
lengthMenu = c(3, 5, 10) |
|||
) |
|||
) |
|||
}) |
|||
} |
|||
) |
|||
} |
|||
@ -0,0 +1,32 @@ |
|||
elineareaUI<- function(id){ |
|||
ns<-NS(id) |
|||
echarts4rOutput("elaplot") |
|||
} |
|||
|
|||
elineareaServer<-function(id, dat){ |
|||
moduleServer( |
|||
id, |
|||
function(input,output,session){ |
|||
output$elaplot<- renderEcharts4r({ |
|||
dat |> |
|||
e_chart(x=month) |> |
|||
e_line(serie = deviation.percent, smooth=T, color="cyan") |> |
|||
e_area(serie = deviation.percent, smooth=T, color="cyan") |> |
|||
e_axis_labels(x = "month", y="Deviation") |> |
|||
e_format_y_axis(suffix = " %") |> |
|||
e_title("Deviation", "Selected Cost Centers") |> |
|||
e_tooltip(formatter = htmlwidgets::JS(" |
|||
function(params){ |
|||
return('Month: ' + params.value[0] + '<br />Deviation: ' + params.value[1] + '%') |
|||
} |
|||
") |
|||
) |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = c(0, 1)) |> |
|||
e_toolbox_feature(feature = c("saveAsImage","dataView")) |> |
|||
e_theme("forest") |
|||
|
|||
}) |
|||
} |
|||
) |
|||
} |
|||
@ -0,0 +1,27 @@ |
|||
stepUI<- function(id){ |
|||
ns<-NS(id) |
|||
echarts4rOutput("elaplot") |
|||
} |
|||
|
|||
stepServer<-function(id, dat){ |
|||
moduleServer( |
|||
id, |
|||
function(input,output,session){ |
|||
output$elaplot<- renderEcharts4r({ |
|||
dat |> |
|||
e_charts(cost_gl) |> |
|||
e_bar(Plan, name = "Plan", color="gray") |> |
|||
e_step(Actual, name = "Actual", color="red") |> |
|||
e_axis_labels(x = "GL+Cost Center", y="Deviation") |> |
|||
e_title("Selected Cost Centers") |> |
|||
e_tooltip() |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = 0, type = "slider") |> |
|||
e_datazoom(y_index = 0, type = "slider") |> |
|||
e_toolbox_feature(feature = c("saveAsImage","dataView")) |> |
|||
e_theme("chalk") |
|||
|
|||
}) |
|||
} |
|||
) |
|||
} |
|||
@ -0,0 +1,24 @@ |
|||
|
|||
valueUI<- function(id){ |
|||
ns<-NS(id) |
|||
valueBoxOutput(ns("vbox")) |
|||
} |
|||
|
|||
valueServer<-function(id, ttl="title",n,icn="credit-card",clr="red",symbl){ |
|||
moduleServer( |
|||
id, |
|||
function(input,output,session){ |
|||
#print(n()) |
|||
output$vbox<- renderValueBox({ |
|||
valueBox( |
|||
paste0(n," ", symbl), |
|||
ttl, |
|||
icon=icon(icn), |
|||
color = clr |
|||
) |
|||
}) |
|||
|
|||
|
|||
} |
|||
) |
|||
} |
|||
@ -0,0 +1,568 @@ |
|||
# Server logic |
|||
# Budget variation tracking of Aramco |
|||
# ::::::Asitav Sen:::::: |
|||
# ::LaNubia Consulting:: |
|||
|
|||
library(shiny) |
|||
|
|||
# Define server logic |
|||
shinyServer(function(input, output, session) { |
|||
res_auth <- secure_server( |
|||
check_credentials = check_credentials("cred.sqlite", |
|||
passphrase = "kJuyhG657Hj&^%gshj*762hjsknh&662"), |
|||
keep_token=TRUE |
|||
) |
|||
|
|||
output$menu <- renderMenu({ |
|||
if (res_auth$admin == FALSE) { |
|||
other.menu |
|||
} else |
|||
admin.menu |
|||
}) |
|||
|
|||
# Connect to DB |
|||
connec <- dbConnect( |
|||
RPostgres::Postgres(), |
|||
dbname = dsn_database, |
|||
host = dsn_hostname, |
|||
port = dsn_port, |
|||
user = dsn_uid, |
|||
password = dsn_pwd |
|||
) |
|||
|
|||
# On stop disconnect from DB |
|||
onStop(function() { |
|||
dbDisconnect(connec) |
|||
}) |
|||
|
|||
# Getting the data from DB |
|||
dat <- reactive({ |
|||
dbGetQuery(connec, |
|||
'SELECT * FROM calculated') |
|||
#get.db.data('SELECT * FROM calculated') |
|||
}) |
|||
|
|||
# Getting deviation limits from DB |
|||
lims <- reactive({ |
|||
dbGetQuery(connec, |
|||
'SELECT * FROM limits') |
|||
#get.db.data('SELECT * FROM limits') |
|||
}) |
|||
|
|||
# Getting the explanations from DB |
|||
|
|||
exp <- reactive({ |
|||
dbGetQuery(connec, |
|||
'SELECT * FROM explanations') |
|||
#get.db.data('SELECT * FROM explanations') |
|||
}) |
|||
|
|||
# Getting approval Table from DB |
|||
approvals <- reactive({ |
|||
dbGetQuery(connec, |
|||
'SELECT * FROM approvals') |
|||
#get.db.data('SELECT * FROM approvals') |
|||
}) |
|||
|
|||
# Getting email ids |
|||
|
|||
emailids <- reactive({ |
|||
dbGetQuery(connec, |
|||
'SELECT * FROM emails') |
|||
#get.db.data('SELECT * FROM emails') |
|||
}) |
|||
|
|||
|
|||
dat.need.exp <- reactive({ |
|||
req(dat()) |
|||
dat() |> |
|||
inner_join(lims(), by = c("GL.account")) |> |
|||
mutate(act.req = ifelse(devia.per > Limit & |
|||
devia > input$limittoignore, T, F)) |> |
|||
filter(act.req) |> |
|||
left_join( |
|||
exp(), |
|||
by = c( |
|||
"month" = "month", |
|||
"Cost.center" = "Cost.center", |
|||
"GL.account" = "GL.account" |
|||
) |
|||
) |> |
|||
filter(is.na(explanation) | explanation == "") |
|||
}) |
|||
|
|||
# Update the gl account selector |
|||
observeEvent(input$costcenter, { |
|||
req(dat()) |
|||
choi <- dat() |> |
|||
filter(Cost.center %in% input$costcenter) |> |
|||
select(GL.account) |> distinct() |> pull() |
|||
updatePickerInput( |
|||
session = session, |
|||
inputId = "glaccount", |
|||
choices = choi, |
|||
selected = choi |
|||
) |
|||
|
|||
}) |
|||
|
|||
|
|||
observeEvent(c(input$costcenter, input$glaccount), { |
|||
# Creating data that will be filtered using the GL and cost center selection |
|||
dat.filtered <- dat() |> |
|||
filter(Cost.center %in% input$costcenter) |> |
|||
filter(GL.account %in% input$glaccount) |> |
|||
mon.dev() |> |
|||
filter(month == max(month)) |
|||
last.var.per <- dat.filtered |> |
|||
pull(deviation.percent) #Last variation percent |
|||
|
|||
last.var.abs <- dat.filtered |> |
|||
pull(devia) #Last variation absolute val |
|||
|
|||
last.exp.act <- dat.filtered |> |
|||
pull(Actual) #Last expense |
|||
|
|||
valueServer( |
|||
"variation", |
|||
ttl = "Latest Variation %", |
|||
n = last.var.per, |
|||
icn = "percent", |
|||
clr = "red", |
|||
symbl = "%" |
|||
) |
|||
|
|||
valueServer( |
|||
"variabs", |
|||
ttl = "Last Variation Amount", |
|||
n = last.var.abs, |
|||
icn = "dollar-sign", |
|||
clr = "green", |
|||
symbl = "$" |
|||
) |
|||
|
|||
valueServer( |
|||
"actexpe", |
|||
ttl = "Last Expense", |
|||
n = last.exp.act, |
|||
icn = "coins", |
|||
clr = "blue", |
|||
symbl = "$" |
|||
) |
|||
|
|||
}) |
|||
|
|||
# Data selected after aplying the filters of cost center and gl account |
|||
dat.selected <- reactive({ |
|||
req(dat()) |
|||
req(input$costcenter) |
|||
req(input$glaccount) |
|||
|
|||
dat() |> |
|||
filter(Cost.center %in% input$costcenter) |> |
|||
filter(GL.account %in% input$glaccount) |
|||
}) |
|||
|
|||
# Monthly aggregate |
|||
dat.monthly.per <- reactive({ |
|||
req(dat.selected()) |
|||
dat.selected() |> |
|||
mutate(month = ym(month)) |> |
|||
group_by(month) |> |
|||
summarise(Plan = sum(Plan), Actual = sum(Actual)) |> |
|||
mutate(devia = Actual - Plan) |> |
|||
mutate(deviation.percent = round(devia * 100 / Plan, 2)) |
|||
}) |
|||
|
|||
|
|||
|
|||
# Monthly percentage deviation |
|||
output$monthlypervar <- renderEcharts4r({ |
|||
req(dat.monthly.per()) |
|||
|
|||
|
|||
e_chart(dat.monthly.per(), x = month) |> |
|||
e_line(serie = deviation.percent, |
|||
smooth = T, |
|||
color = "cyan", opacity=0.8) |> |
|||
e_area(serie = deviation.percent, |
|||
smooth = T, |
|||
color = "gray", opacity=0.6) |> |
|||
e_axis_labels(x = "month", y = "Deviation") |> |
|||
e_format_y_axis(suffix = " %") |> |
|||
e_tooltip() |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = c(0, 1)) |> |
|||
e_image_g( |
|||
right = 50, |
|||
top = 20, |
|||
z = -999, |
|||
style = list( |
|||
image = "logo.png", |
|||
width = 75, |
|||
height = 75, |
|||
opacity = .6 |
|||
) |
|||
) |> |
|||
e_toolbox_feature(feature = c("saveAsImage", "dataView")) |> |
|||
e_theme("roma") |
|||
}) |
|||
|
|||
# Monthly Absolute Deviation |
|||
dat.monthly.abs <- reactive({ |
|||
dat.selected() |> |
|||
filter(month == input$mont) |> |
|||
mutate(cost_gl = paste0(Cost.center, "_", GL.account)) |> |
|||
group_by(cost_gl) |> |
|||
summarise(Plan = sum(Plan), Actual = sum(Actual)) |> |
|||
mutate(devia = Actual - Plan) |> |
|||
mutate(deviation.percent = round(devia * 100 / Plan, 2)) |> |
|||
arrange(desc(deviation.percent)) |
|||
}) |
|||
|
|||
# Monthly absolute by cost center + gl account |
|||
output$monthlyabs <- renderEcharts4r({ |
|||
req(dat.monthly.abs()) |
|||
dat.monthly.abs() |> |
|||
e_charts(cost_gl) |> |
|||
e_bar(Plan, name = "Plan", color = "gray", opacity=0.6) |> |
|||
e_step(Actual, name = "Actual", color = "red") |> |
|||
e_axis_labels(x = "GL+Cost Center", y = "Deviation") |> |
|||
#e_title("Plan Vs. Actual") |> |
|||
e_tooltip() |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = 0, type = "slider") |> |
|||
e_datazoom(y_index = 0, type = "slider") |> |
|||
e_image_g( |
|||
right = 50, |
|||
top = 20, |
|||
z = -999, |
|||
style = list( |
|||
image = "logo.png", |
|||
width = 75, |
|||
height = 75, |
|||
opacity = .6 |
|||
) |
|||
) |> |
|||
e_toolbox_feature(feature = c("saveAsImage", "dataView")) |> |
|||
e_theme("roma") |
|||
}) |
|||
|
|||
output$monthlyabsvar <- renderEcharts4r({ |
|||
req(dat.monthly.per()) |
|||
|
|||
e_chart(dat.monthly.per(), x = month) |> |
|||
e_bar(serie = devia) |> |
|||
e_axis_labels(x = "month", y = "Deviation") |> |
|||
e_format_y_axis(suffix = "€") |> |
|||
#e_title("Deviation Percentage by month") |> |
|||
e_tooltip() |> |
|||
e_legend(right = 100) |> |
|||
e_datazoom(x_index = c(0, 1)) |> |
|||
e_image_g( |
|||
right = 50, |
|||
top = 20, |
|||
z = -999, |
|||
style = list( |
|||
image = "logo.png", |
|||
width = 75, |
|||
height = 75, |
|||
opacity = .6 |
|||
) |
|||
) |> |
|||
e_visual_map(type = "piecewise", |
|||
pieces = list(list(gt = 0, |
|||
color = "red", opacity=0.5), |
|||
list(lte = 0, |
|||
color = "green", opacity=0.5))) |> |
|||
e_toolbox_feature(feature = c("saveAsImage", "dataView")) |> |
|||
e_theme("roma") |
|||
|
|||
}) |
|||
|
|||
# Table of deviations without explanation |
|||
|
|||
|
|||
datatableServer("devnoexp", dat.need.exp) |
|||
|
|||
# Notify |
|||
|
|||
observeEvent(input$notify, { |
|||
req(dat.need.exp()) |
|||
emaildf<-dat.need.exp() |> |
|||
inner_join(emailids(), by=c("Cost.center"="Cost.center","GL.account"="GL.account")) |
|||
print(emaildf) |
|||
if(is.null(emaildf) | nrow(emaildf)==0){ |
|||
showModal(modalDialog("No Data")) |
|||
} else { |
|||
emails<- |
|||
emaildf |> |
|||
select(email) |> pull() |> unique() |
|||
|
|||
for(i in 1:length(emails)){ |
|||
tbl <- emaildf |> |
|||
filter(email==emails[i]) |> kbl() |
|||
date_time <- add_readable_time() |
|||
email <- |
|||
compose_email(body = md(c( |
|||
glue::glue( |
|||
"Hello, |
|||
|
|||
Explanation required for expense deviation. Please visit xyz. Details are as follows. |
|||
|
|||
" |
|||
), |
|||
tbl |
|||
)), |
|||
footer = md(glue::glue("Email sent on {date_time}."))) |
|||
|
|||
email |> |
|||
smtp_send( |
|||
to = emails[i], |
|||
from = "asitav.sen@lanubia.com", |
|||
subject = "Testing", |
|||
credentials = creds_file("email_creds") |
|||
) |
|||
} |
|||
|
|||
|
|||
|
|||
showModal(modalDialog(title = "Done")) |
|||
} |
|||
|
|||
}) |
|||
|
|||
# Approvals |
|||
output$expnoapp <- renderExcel({ |
|||
req(approvals()) |
|||
appro <- approvals() |
|||
row.names(appro) <- NULL |
|||
appro <- appro[appro$approved == FALSE, ] |
|||
columns = data.frame( |
|||
title = colnames(appro), |
|||
type = c('numeric', 'text', 'text', 'text', 'checkbox') |
|||
) |
|||
excelTable(data = appro, columns = columns, autoFill = TRUE) |
|||
|
|||
}) |
|||
|
|||
# Update approvals |
|||
observeEvent(input$approvalsubmit, { |
|||
approved.now <- excel_to_R(input$expnoapp) |
|||
if (is.null(input$expnoapp) || nrow(approved.now) == 0) { |
|||
showModal(modalDialog(title = "Nothing to Upload")) |
|||
} else{ |
|||
showModal(modalDialog(title = "Upload in Database?", |
|||
actionButton("finalapprovalsubmit", "Yes"))) |
|||
} |
|||
|
|||
}) |
|||
|
|||
|
|||
observeEvent(input$finalapprovalsubmit, { |
|||
appro <- approvals() |
|||
appro <- appro[appro$approved == TRUE, ] |
|||
approved.now <- excel_to_R(input$expnoapp) |
|||
appro <- rbind(appro, approved.now) |
|||
if (nrow(approved.now) > 0) { |
|||
if (dbWriteTable(connec, "approvals", appro, overwrite = TRUE)) { |
|||
removeModal() |
|||
session$reload() |
|||
} |
|||
} |
|||
|
|||
|
|||
}) |
|||
|
|||
# New Data |
|||
fresh.dat <- reactive({ |
|||
req(input$inpfile) |
|||
file <- input$inpfile |
|||
ext <- tools::file_ext(file$datapath) |
|||
req(file) |
|||
validate(need(ext == "csv", "Please upload a csv file")) |
|||
new.dat <- read.csv(file$datapath, header = T) |
|||
new.dat |> |
|||
mutate(devia = Actual - Plan) |> |
|||
mutate(devia.per = round(devia / Plan, 2)) |
|||
}, label = "fresh") |
|||
|
|||
# Show uploaded data |
|||
datatableServer("freshdat", fresh.dat) |
|||
|
|||
# Update DB |
|||
observeEvent(input$datsubmit, { |
|||
req(nrow(fresh.dat()) > 0) |
|||
fresh.dt <- fresh.dat() |
|||
if (is.null(fresh.dt) || nrow(fresh.dt) == 0) { |
|||
showModal(modalDialog(title = "Nothing to Upload")) |
|||
} else{ |
|||
showModal(modalDialog(title = "Upload in Database?", |
|||
actionButton("finaldatsubmit", "Yes"))) |
|||
} |
|||
|
|||
}) |
|||
|
|||
|
|||
observeEvent(input$finaldatsubmit, { |
|||
fresh.dt <- fresh.dat() |
|||
if (nrow(fresh.dt) > 0) { |
|||
if (dbWriteTable(connec, "calculated", fresh.dt, append = TRUE)) { |
|||
unique(fresh.dt$month) |> saveRDS("./data/months.RDS") |
|||
removeModal() |
|||
session$reload() |
|||
} |
|||
} |
|||
}) |
|||
|
|||
|
|||
|
|||
# Email id edit and show |
|||
output$emailtable <- renderExcel({ |
|||
req(emailids()) |
|||
email.table <- emailids() |
|||
columns = data.frame(title = colnames(email.table), |
|||
type = c('text', 'text', 'text')) |
|||
excelTable(data = email.table, columns = columns, autoFill = TRUE) |
|||
|
|||
}) |
|||
|
|||
# Email id table update |
|||
|
|||
observeEvent(input$emailsubmit, { |
|||
email.table <- excel_to_R(input$emailtable) |
|||
if (is.null(input$emailtable) || nrow(email.table) == 0) { |
|||
showModal(modalDialog(title = "Nothing to Upload")) |
|||
} else{ |
|||
showModal(modalDialog(title = "Upload in Database?", |
|||
actionButton("finalemailsubmit", "Yes"))) |
|||
} |
|||
|
|||
}) |
|||
|
|||
|
|||
observeEvent(input$finalemailsubmit, { |
|||
email.table <- excel_to_R(input$emailtable) |
|||
if (nrow(email.table) > 0) { |
|||
if (dbWriteTable(connec, "emails", email.table, overwrite = TRUE)) { |
|||
removeModal() |
|||
session$reload() |
|||
} |
|||
} |
|||
}) |
|||
|
|||
# Limits (deviation rules) id edit and show |
|||
output$limitable <- renderExcel({ |
|||
req(lims()) |
|||
limit.table <- lims() |
|||
columns = data.frame(title = colnames(limit.table), |
|||
type = c('text', 'numeric')) |
|||
excelTable(data = limit.table, columns = columns, autoFill = TRUE) |
|||
|
|||
}) |
|||
|
|||
# Email id table update |
|||
|
|||
observeEvent(input$limitsubmit, { |
|||
limit.table <- excel_to_R(input$limitable) |
|||
if (is.null(input$limitable) || nrow(limit.table) == 0) { |
|||
showModal(modalDialog(title = "Nothing to Upload")) |
|||
} else{ |
|||
showModal(modalDialog(title = "Upload in Database?", |
|||
actionButton("finallimitsubmit", "Yes"))) |
|||
} |
|||
|
|||
}) |
|||
|
|||
|
|||
observeEvent(input$finallimitsubmit, { |
|||
limit.table <- excel_to_R(input$limitable) |
|||
if (nrow(limit.table) > 0) { |
|||
if (dbWriteTable(connec, "limits", limit.table, overwrite = TRUE)) { |
|||
removeModal() |
|||
session$reload() |
|||
} |
|||
} |
|||
}) |
|||
|
|||
# User specific explanation filter |
|||
user.accounts <- reactive({ |
|||
req(dat()) |
|||
req(emailids()) |
|||
req(exp()) |
|||
req(res_auth$email) |
|||
dat() |> |
|||
inner_join(lims(), by = c("GL.account")) |> |
|||
mutate(act.req = ifelse(devia.per > Limit & |
|||
devia > input$limittoignore, T, F)) |> #change 500 to input |
|||
filter(act.req) |> |
|||
left_join(emailids(), |
|||
by = c("Cost.center" = "Cost.center", "GL.account" = "GL.account")) |> |
|||
left_join( |
|||
exp(), |
|||
by = c( |
|||
"month" = "month", |
|||
"Cost.center" = "Cost.center", |
|||
"GL.account" = "GL.account" |
|||
) |
|||
) |> |
|||
filter(is.na(explanation) | explanation == "") |> |
|||
filter(email == res_auth$email) |> |
|||
select(-c(9, 10)) |
|||
}) |
|||
|
|||
output$explanationtofill <- renderExcel({ |
|||
req(user.accounts()) |
|||
explanation.table <- user.accounts() |
|||
columns = data.frame( |
|||
title = colnames(explanation.table), |
|||
type = c( |
|||
'numeric', |
|||
'text', |
|||
'text', |
|||
'numeric', |
|||
'numeric', |
|||
'numeric', |
|||
'numeric', |
|||
'numeric', |
|||
'text' |
|||
) |
|||
) |
|||
excelTable(data = explanation.table, columns = columns, autoFill = TRUE) |
|||
|
|||
}) |
|||
|
|||
|
|||
# Explanations table update |
|||
|
|||
observeEvent(input$explanationsubmit, { |
|||
explanation.table <- excel_to_R(input$explanationtofill) |
|||
if (is.null(input$explanationtofill) || |
|||
nrow(explanation.table) == 0) { |
|||
showModal(modalDialog(title = "Nothing to Upload")) |
|||
} else{ |
|||
showModal(modalDialog(title = "Upload in Database?", |
|||
actionButton("finalexpsubmit", "Yes"))) |
|||
} |
|||
|
|||
}) |
|||
|
|||
|
|||
observeEvent(input$finalexpsubmit, { |
|||
explanation.table <- excel_to_R(input$explanationtofill) |
|||
explanation.table <- explanation.table |> |
|||
select(c(month, Cost.center, GL.account, explanation)) |
|||
if (nrow(explanation.table) > 0) { |
|||
if (dbWriteTable(connec, "explanations", explanation.table, append = TRUE)) { |
|||
appr <- explanation.table |> mutate(approved = F) |
|||
if (dbWriteTable(connec, "approvals", appr, append = TRUE)) { |
|||
removeModal() |
|||
session$reload() |
|||
} |
|||
|
|||
} |
|||
} |
|||
}) |
|||
|
|||
|
|||
}) |
|||
@ -0,0 +1,125 @@ |
|||
# |
|||
# Custom App developed for Finance Team of Aramco |
|||
# ::Asitav Sen:: |
|||
# ::LaNubia Consulting:: |
|||
# ::asitav.sen@lanubia.com:: |
|||
# |
|||
|
|||
library(shiny) |
|||
library(shinydashboard) |
|||
library(countup) |
|||
library(shinyWidgets) |
|||
library(shinydashboardPlus) |
|||
library(DBI) |
|||
library(RPostgres) |
|||
library(dplyr) |
|||
library(echarts4r) |
|||
library(lubridate) |
|||
library(DT) |
|||
library(excelR) |
|||
library(blastula) |
|||
library(shinymanager) |
|||
library(glue) |
|||
library(shinythemes) |
|||
library(kableExtra) |
|||
library(waiter) |
|||
|
|||
|
|||
|
|||
source("helper_server.R") |
|||
source("mod_valuebox.R") |
|||
source("mod_elinearea.R") |
|||
source("mod_step.R") |
|||
source("mod_datatable.R") |
|||
source("helper_ui.R") |
|||
|
|||
# Define UI for application |
|||
|
|||
shinyUI( |
|||
secure_app( |
|||
shinydashboardPlus::dashboardPage( |
|||
title = "Budgetrack", |
|||
#skin = "blue-light", |
|||
#skin = "midnight", |
|||
header = shinydashboardPlus::dashboardHeader(title = "Budgetrack"), |
|||
sidebar = shinydashboardPlus::dashboardSidebar( |
|||
sidebarMenuOutput("menu") |
|||
), |
|||
body = dashboardBody( |
|||
|
|||
tags$head(tags$style(HTML( |
|||
|
|||
' |
|||
/* logo */ |
|||
.skin-blue .main-header .logo { |
|||
background-color: #0477ci; |
|||
} |
|||
|
|||
/* logo when hovered */ |
|||
.skin-blue .main-header .logo:hover { |
|||
background-color: #009adc; |
|||
} |
|||
|
|||
/* navbar (rest of the header) */ |
|||
.skin-blue .main-header .navbar { |
|||
background-color: #0033a0; |
|||
} |
|||
|
|||
/* main sidebar */ |
|||
.skin-blue .main-sidebar { |
|||
background-color: #ffffff; |
|||
} |
|||
|
|||
/* active selected tab in the sidebarmenu */ |
|||
.skin-blue .main-sidebar .sidebar .sidebar-menu .active a{ |
|||
background-color: #01a54b; |
|||
} |
|||
|
|||
/* other links in the sidebarmenu */ |
|||
.skin-blue .main-sidebar .sidebar .sidebar-menu a{ |
|||
background-color: #ffffff; |
|||
color: #000000; |
|||
} |
|||
|
|||
/* other links in the sidebarmenu when hovered */ |
|||
.skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{ |
|||
background-color: #009adc; |
|||
} |
|||
' |
|||
|
|||
))), |
|||
tabItems(dashboard, |
|||
upload, |
|||
appndev, |
|||
explan, |
|||
admin)) |
|||
), |
|||
enable_admin = TRUE, |
|||
theme = shinythemes::shinytheme("united"), |
|||
tags_top = |
|||
tags$div( |
|||
tags$h4("Created exclusively for ", style ="align:center"), |
|||
br(), |
|||
tags$img( |
|||
src = "https://www.aramco.com/images/affiliateLogo-2x.png", width = 100 |
|||
), |
|||
br(), |
|||
br(), |
|||
tags$h4("By", style ="align:center"), |
|||
tags$img(src="logo.png", width=100) |
|||
), |
|||
tags_bottom = tags$p( |
|||
"For any question, please contact", |
|||
tags$a( |
|||
href ="mailto:asitav.sen@lanubia.com?Subject=Aramco%20aBugdet", |
|||
target="_top","Asitav Sen" |
|||
) |
|||
), |
|||
background = "linear-gradient(225deg,rgb(0,163,224), |
|||
rgb(0,51,160), |
|||
rgb(0,132,61), |
|||
rgb(132,189,0));" |
|||
) |
|||
|
|||
) |
|||
|
|||
|
After Width: | Height: | Size: 68 KiB |
|
After Width: | Height: | Size: 11 KiB |
Loading…
Reference in new issue