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