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