commit
6b7553069d
12 changed files with 343 additions and 0 deletions
@ -0,0 +1,4 @@ |
|||||
|
.Rproj.user |
||||
|
.Rhistory |
||||
|
.RData |
||||
|
.Ruserdata |
||||
@ -0,0 +1,108 @@ |
|||||
|
# |
||||
|
#Shiny web application |
||||
|
# ::Asitav Sen:: |
||||
|
# ******Important******* |
||||
|
# Please check the template. This code supports only single select option. In the csv, separate the answer options with "/" |
||||
|
# |
||||
|
|
||||
|
|
||||
|
library(shiny) |
||||
|
library(DBI) |
||||
|
library(shinymanager) |
||||
|
library(DT) |
||||
|
library(excelR) |
||||
|
library(bslib) |
||||
|
library(dplyr) |
||||
|
library(shinydashboard) |
||||
|
library(shinydashboardPlus) |
||||
|
library(dbplyr) |
||||
|
|
||||
|
|
||||
|
source("utilities.R") |
||||
|
source("helper_ui.R") |
||||
|
source("helper_server.R") |
||||
|
|
||||
|
# Define UI |
||||
|
|
||||
|
|
||||
|
ui <- secure_app(uidet, enable_admin = TRUE) |
||||
|
|
||||
|
# Define server logic |
||||
|
server <- function(input, output) { |
||||
|
|
||||
|
onStop(db.disc, session = getDefaultReactiveDomain()) |
||||
|
|
||||
|
res_auth <- secure_server( |
||||
|
check_credentials = check_credentials("cred.sqlite", |
||||
|
passphrase = "kJuyhG657Hj&^%gshj*762hjsknh&662") |
||||
|
) |
||||
|
|
||||
|
output$menu <- renderMenu({ |
||||
|
if (res_auth$admin == FALSE) { |
||||
|
survey.menu |
||||
|
} else |
||||
|
admin.menu |
||||
|
}) |
||||
|
|
||||
|
output$grouptable <- renderUI({ |
||||
|
tablelist <- lapply(1:no.of.dims, function(i) { |
||||
|
tablename <- |
||||
|
paste("table", i, unique(question.dfs[[i]]$segment), sep = "") |
||||
|
list(tabPanel( |
||||
|
unique(question.dfs[[i]]$segment), |
||||
|
h2(unique(question.dfs[[i]]$segment)), |
||||
|
excelOutput(tablename, height = "900px") |
||||
|
)) |
||||
|
|
||||
|
}) |
||||
|
|
||||
|
do.call(tabsetPanel, unlist(tablelist, recursive = FALSE)) |
||||
|
|
||||
|
}) |
||||
|
|
||||
|
for (i in 1:no.of.dims) { |
||||
|
local({ |
||||
|
mdf <- question.dfs[[i]] |
||||
|
tablename <- |
||||
|
paste("table", i, unique(question.dfs[[i]]$segment), sep = "") |
||||
|
output[[tablename]] <- renderExcel({ |
||||
|
nrmdf <- nrow(mdf) |
||||
|
dat <- |
||||
|
data.frame(matrix(nrow = nrow(use_cases), ncol = nrow(mdf) + 2)) |
||||
|
colnames(dat) <- c("Strategic Pillar","Use Cases", mdf$question) |
||||
|
dat[, 1] <- use_cases$strategy |
||||
|
dat[, 2] <- use_cases$use_cases |
||||
|
qlist <- list(0,0) |
||||
|
olist <- strsplit(mdf$answers, split = "/") |
||||
|
excelTable( |
||||
|
data = dat, |
||||
|
columns = data.frame( |
||||
|
title = c("Strategic Pillar","Use Cases", mdf$question), |
||||
|
type = c("text","text", rep("dropdown", nrow(mdf))), |
||||
|
source = I(append(qlist, olist)) |
||||
|
), |
||||
|
#autoWidth = TRUE, |
||||
|
#autoFill = TRUE, |
||||
|
#wordWrap = TRUE, |
||||
|
columnSorting = FALSE, |
||||
|
rowDrag = FALSE, |
||||
|
allowDeleteColumn = FALSE, |
||||
|
allowRenameColumn = FALSE, |
||||
|
allowInsertRow = FALSE, |
||||
|
allowInsertColumn = FALSE, |
||||
|
allowDeleteRow = FALSE, |
||||
|
tableHeight = 400 |
||||
|
|
||||
|
) |
||||
|
}) |
||||
|
}) |
||||
|
|
||||
|
|
||||
|
} |
||||
|
|
||||
|
|
||||
|
|
||||
|
} |
||||
|
|
||||
|
# Run the application |
||||
|
shinyApp(ui = ui, server = server) |
||||
Binary file not shown.
@ -0,0 +1,35 @@ |
|||||
|
admin.menu<-sidebarMenu( |
||||
|
id="m", |
||||
|
menuItem( |
||||
|
"dashboard", |
||||
|
tabName = "Dashboard", |
||||
|
icon=icon("dashboard") |
||||
|
), |
||||
|
menuItem( |
||||
|
"input", |
||||
|
tabName = "Input", |
||||
|
icon=icon("dashboard") |
||||
|
), |
||||
|
menuItem("Contact us", icon=icon("id-card"), href="https://lanubia.com/contact/") |
||||
|
) |
||||
|
|
||||
|
survey.menu<-sidebarMenu( |
||||
|
id="m", |
||||
|
menuItem( |
||||
|
"survey", |
||||
|
tabName = "Survey", |
||||
|
icon = icon("clipboard-list") |
||||
|
), |
||||
|
menuItem( |
||||
|
"personal", |
||||
|
tabName = "Personal", |
||||
|
icon = icon("user") |
||||
|
), |
||||
|
menuItem("Contact us", icon=icon("id-card"), href="https://lanubia.com/contact/") |
||||
|
) |
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
@ -0,0 +1,72 @@ |
|||||
|
|
||||
|
sdbar<-dashboardSidebar( |
||||
|
collapsed = FALSE, |
||||
|
sidebarMenuOutput("menu")#, |
||||
|
# p(style = "text-align: center;", "An Initiative by"), |
||||
|
# lanubialogo, |
||||
|
# p(style = "text-align: center;", "&"), |
||||
|
# jadslogo, |
||||
|
# p(style = "text-align: center;", "For"), |
||||
|
# clientlogo, |
||||
|
# actionButton("submit", "Submit All") |
||||
|
) |
||||
|
|
||||
|
|
||||
|
uidet <- shinydashboardPlus::dashboardPage( |
||||
|
title = "Clotho", |
||||
|
skin = "black-light", |
||||
|
header = shinydashboardPlus::dashboardHeader(title = "Clotho"), |
||||
|
sidebar = sdbar, |
||||
|
body = dashboardBody(tabItems( |
||||
|
tabItem( |
||||
|
tabName = "Survey", |
||||
|
shinydashboardPlus::box( |
||||
|
width = 12, |
||||
|
solidHeader = T, |
||||
|
title = "Instructions", |
||||
|
fluidRow(column( |
||||
|
width = 10, |
||||
|
h5( |
||||
|
"Please double click the cells and select the desired value. Once all the tabs are done, please click the submit button." |
||||
|
) |
||||
|
), |
||||
|
column( |
||||
|
width = 2, |
||||
|
actionButton("submitdata", "Submit All") |
||||
|
)) |
||||
|
|
||||
|
), |
||||
|
|
||||
|
shinydashboardPlus::box(title = "Survey", |
||||
|
width = 12, |
||||
|
uiOutput("grouptable") |
||||
|
) |
||||
|
), |
||||
|
tabItem( |
||||
|
tabName = "Personal", |
||||
|
shinydashboardPlus::box( |
||||
|
width = 6, |
||||
|
title = "Other info", |
||||
|
sel.depp, |
||||
|
sel.func, |
||||
|
sel.gender, |
||||
|
sel.age, |
||||
|
timeondata, |
||||
|
footer = actionButton("submitinfo", "Submit") |
||||
|
) |
||||
|
|
||||
|
), |
||||
|
tabItem(tabName = "Dashboard"), |
||||
|
tabItem( |
||||
|
tabName = "Input" |
||||
|
) |
||||
|
)), |
||||
|
footer = shinydashboardPlus::dashboardFooter(left = "LaNubia Consulting", right = "Built for Kraft Heinz R & D, Netherlands"), |
||||
|
controlbar = dashboardControlbar(collapsed = TRUE, tagList("Change Skin", |
||||
|
skinSelector())) |
||||
|
) |
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
@ -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 |
||||
@ -0,0 +1,70 @@ |
|||||
|
|
||||
|
df <- NULL |
||||
|
|
||||
|
questions <- read.csv("./data/questions.csv") |
||||
|
use_cases <- read.csv("./data/use_cases.csv") |
||||
|
|
||||
|
dsn_database <- "priority" |
||||
|
dsn_hostname <- "priority-lanubia.postgres.database.azure.com" |
||||
|
dsn_port <- "5432" |
||||
|
dsn_uid <- "lanubia" |
||||
|
dsn_pwd <- "kjHuye98837*&38hjksmk((7hksakjd0nk" |
||||
|
|
||||
|
connec <- dbConnect( |
||||
|
RPostgres::Postgres(), |
||||
|
dbname = dsn_database, |
||||
|
host = dsn_hostname, |
||||
|
port = dsn_port, |
||||
|
user = dsn_uid, |
||||
|
password = dsn_pwd |
||||
|
) |
||||
|
|
||||
|
db.tables <- dbListTables(connec) |
||||
|
|
||||
|
db.disc<-function(){ |
||||
|
dbDisconnect(connec) |
||||
|
} |
||||
|
|
||||
|
q_dfs <- function(dimension) { |
||||
|
questions |> |
||||
|
filter(segment == dimension) |
||||
|
} |
||||
|
|
||||
|
question.dfs<-lapply(unique(questions$segment), q_dfs) |
||||
|
|
||||
|
no.of.dims<-length(question.dfs) |
||||
|
|
||||
|
|
||||
|
sel.depp<-selectizeInput( |
||||
|
"deptt", |
||||
|
"Business Area", |
||||
|
choices = c( |
||||
|
"R&D", |
||||
|
"Supply Chain", |
||||
|
"Marketing", |
||||
|
"Sales", |
||||
|
"Finance", |
||||
|
"IT", |
||||
|
"HR", |
||||
|
"Other" |
||||
|
) |
||||
|
) |
||||
|
sel.func<-selectizeInput( |
||||
|
"func", |
||||
|
"Function Level", |
||||
|
choices = c("Board", "Director", |
||||
|
"Manager", "Expert", "Staff", "Other") |
||||
|
) |
||||
|
|
||||
|
sel.gender<- selectizeInput("gender", "Gender", choices = |
||||
|
c("Male", "Female", "Other")) |
||||
|
sel.age<-selectizeInput( |
||||
|
"age", |
||||
|
"Age", |
||||
|
choices = c("18-24", "25-30", "31-40", "41-50", "51-60", "60+") |
||||
|
) |
||||
|
timeondata<-selectizeInput( |
||||
|
"timeondata", |
||||
|
"How much time do you spend on average per day working with data in your current role?", |
||||
|
choices = c("About 1 hour", "About 2 hours", "Most of the time") |
||||
|
) |
||||
|
After Width: | Height: | Size: 9.7 KiB |
|
After Width: | Height: | Size: 84 KiB |
|
After Width: | Height: | Size: 11 KiB |
Loading…
Reference in new issue