The Source Code (relevant):
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
wellPanel(
tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
br(),
div(
style = "text-align: center;",
actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
padding: 10px 15px; width: 150px; cursor: pointer;
font-size: 18px; font-weight: 600;"),
shinyjs::hidden(
div(id = "nomatch",
tags$p("Oops! Incorrect username or password!",
style = "color: red; font-weight: 600;
padding-top: 5px;font-size:16px;",
class = "text-center"))),
br()
# br(),
# tags$code("Username: myuser Password: mypass"),
# br(),
# tags$code("Username: myuser1 Password: mypass1")
))
)
convertMenuItem <- function(mi,tabName) {
mi$children[[1]]$attribs['data-toggle']="tab"
mi$children[[1]]$attribs['data-value'] = "tabName"
mi
}
server <- function(input, output, session) {
# filtered.collaboration <- collaboration
# makeReactiveBinding(filtered.collaboration)
login = FALSE
USER <- reactiveValues(login = login)
observe({
if (USER$login == FALSE) {
if (!is.null(input$login)) {
if (input$login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
if(length(which(credentials$username_id==Username))==1) {
pasmatch <- credentials["passod"][which(credentials$username_id==Username),]
pasverify <- password_verify(pasmatch, Password)
if(pasverify) {
USER$login <- TRUE
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
}
}
}
})
id <- reactive({m <- elenco.emails %>%
filter(value == input$userName) %>%
select(landing_id) %>%
unlist()
m})
# observeEvent(input$info, {
# shinyalert("Queste sono Info inerenti il tuo punteggio", type = "error", closeOnEsc = TRUE, timer = 0, showConfirmButton= TRUE)
# })
#Bottone di More Info
observeEvent(input$info, {
sendSweetAlert(session = session,
title = "Your Score / Il tuo punteggio",
text = tags$span(
tags$h2({giudizio.complessivo()}),
tags$br(),
tags$p({complessivo.inglese()}),
tags$br(),
tags$p({complessivo.italiano()}),
tags$br(),
tags$strong(paste0(sprintf("Your total score %.2f, which compared to the best achievable is %.2f",
a = round(mean({risposte.reattive()}$Mark),2),
b = (round(mean({risposte.reattive()}$Mark),2)/5)*100),"%")),
tags$br(),
tags$strong(sprintf("Your score on Knowledge and Tools is %.2f", a = {knowledge.value()})),
tags$br(),
tags$strong(sprintf("Your score on Resilience is %.2f", a = {resilience.value()})),
tags$br(),
tags$strong(sprintf("Your score on Culture and Behaviours is %.2f", a = {behaviours.value()}))
),
type = "info")
})
filtered.behaviours <- reactive({# Filtri interattivi
filtro.ruolo <- input$ruolo3
filtro.anzianita <- input$anzianita3
filtro.eta <- input$eta3
filtro.educazione <- input$educazione3
# Campi dove filtrare
campo.ruolo <- fields[3,1]
campo.anzianita <- fields[5,1]
campo.eta <- fields[6,1]
campo.educazione <- fields[7,1]
# Id filtrati
risposte.filtro.ruolo <- if (filtro.ruolo == "All") {behaviours %>% select(landing_id)}
else {
responses[[campo.ruolo]] %>%
filter(grepl(filtro.ruolo, value)) %>%
select(landing_id)}
risposte.filtro.anzianita <- if (filtro.anzianita == "All") {behaviours %>% select(landing_id)}
else {
responses[[campo.anzianita]] %>%
filter(grepl(filtro.anzianita, value)) %>%
select(landing_id)}
risposte.filtro.eta <- if (filtro.eta == "All") {behaviours %>% select(landing_id)}
else {
responses[[campo.eta]] %>%
filter(grepl(filtro.eta, value)) %>%
select(landing_id)}
risposte.filtro.educazione <- if (filtro.educazione == "All") {behaviours %>% select(landing_id)}
else {
responses[[campo.educazione]] %>%
filter(grepl(filtro.educazione, value)) %>%
select(landing_id)}
# Data Frame filtrato
m <- behaviours %>%
filter(landing_id %in% risposte.filtro.anzianita$landing_id &
landing_id %in% risposte.filtro.ruolo$landing_id &
landing_id %in% risposte.filtro.eta$landing_id &
landing_id %in% risposte.filtro.educazione$landing_id) %>%
select(-landing_id)
if (filtro.anzianita != "All" | filtro.educazione != "All" | filtro.eta != "All" | filtro.ruolo != "All") {
m <- rbind(behaviours[1:2, 2:ncol(behaviours)], m)
}
if (nrow(m) == 2) {
n <- ncol(behaviours) - 1
a <- as.tibble(matrix(rep(0, n), ncol = n))
colnames(a) <- colnames(behaviours)[2:ncol(behaviours)]
m <- rbind(behaviours[1:2, 2:ncol(behaviours)], a)
}
a <- as.tibble(matrix(rep(0, ncol(m)), ncol = ncol(m)))
colnames(a) <- colnames(m)
for (i in colnames(m)) {
a[[i]] <- mean(m[[i]][3:nrow(m)])
}
m <- rbind(m, a)
m
})
filtered.resilience <- reactive({# Filtri interattivi
filtro.ruolo <- input$ruolo
filtro.anzianita <- input$anzianita
filtro.eta <- input$eta
filtro.educazione <- input$educazione
# Campi dove filtrare
campo.ruolo <- fields[3,1]
campo.anzianita <- fields[5,1]
campo.eta <- fields[6,1]
campo.educazione <- fields[7,1]
# Id filtrati
risposte.filtro.ruolo <- if (filtro.ruolo == "All") {resilience %>% select(landing_id)}
else {
responses[[campo.ruolo]] %>%
filter(grepl(filtro.ruolo, value)) %>%
select(landing_id)}
risposte.filtro.anzianita <- if (filtro.anzianita == "All") {resilience %>% select(landing_id)}
else {
responses[[campo.anzianita]] %>%
filter(grepl(filtro.anzianita, value)) %>%
select(landing_id)}
risposte.filtro.eta <- if (filtro.eta == "All") {resilience %>% select(landing_id)}
else {
responses[[campo.eta]] %>%
filter(grepl(filtro.eta, value)) %>%
select(landing_id)}
risposte.filtro.educazione <- if (filtro.educazione == "All") {resilience %>% select(landing_id)}
else {
responses[[campo.educazione]] %>%
filter(grepl(filtro.educazione, value)) %>%
select(landing_id)}
# Data Frame filtrato
m <- resilience %>%
filter(landing_id %in% risposte.filtro.anzianita$landing_id &
landing_id %in% risposte.filtro.ruolo$landing_id &
landing_id %in% risposte.filtro.eta$landing_id &
landing_id %in% risposte.filtro.educazione$landing_id) %>%
select(-landing_id)
if (filtro.anzianita != "All" | filtro.educazione != "All" | filtro.eta != "All" | filtro.ruolo != "All") {
m <- rbind(resilience[1:2, 2:ncol(resilience)], m)
}
if (nrow(m) == 2) {
n <- ncol(resilience) - 1
a <- as.tibble(matrix(rep(0, n), ncol = n))
colnames(a) <- colnames(resilience)[2:ncol(resilience)]
m <- rbind(resilience[1:2, 2:ncol(resilience)], a)
}
a <- as.tibble(matrix(rep(0, ncol(m)), ncol = ncol(m)))
colnames(a) <- colnames(m)
for (i in colnames(m)) {
a[[i]] <- mean(m[[i]][3:nrow(m)])
}
m <- rbind(m, a)
m
})
filtered.knowledge <- reactive({# Filtri interattivi
filtro.ruolo <- input$ruolo4
filtro.anzianita <- input$anzianita4
filtro.eta <- input$eta4
filtro.educazione <- input$educazione4
# Campi dove filtrare
campo.ruolo <- fields[3,1]
campo.anzianita <- fields[5,1]
campo.eta <- fields[6,1]
campo.educazione <- fields[7,1]
# Id filtrati
risposte.filtro.ruolo <- if (filtro.ruolo == "All") {knowledge %>% select(landing_id)}
else {
responses[[campo.ruolo]] %>%
filter(grepl(filtro.ruolo, value)) %>%
select(landing_id)}
risposte.filtro.anzianita <- if (filtro.anzianita == "All") {knowledge %>% select(landing_id)}
else {
responses[[campo.anzianita]] %>%
filter(grepl(filtro.anzianita, value)) %>%
select(landing_id)}
risposte.filtro.eta <- if (filtro.eta == "All") {knowledge %>% select(landing_id)}
else {
responses[[campo.eta]] %>%
filter(grepl(filtro.eta, value)) %>%
select(landing_id)}
risposte.filtro.educazione <- if (filtro.educazione == "All") {knowledge %>% select(landing_id)}
else {
responses[[campo.educazione]] %>%
filter(grepl(filtro.educazione, value)) %>%
select(landing_id)}
# Data Frame filtrato
m <- knowledge %>%
filter(landing_id %in% risposte.filtro.anzianita$landing_id &
landing_id %in% risposte.filtro.ruolo$landing_id &
landing_id %in% risposte.filtro.eta$landing_id &
landing_id %in% risposte.filtro.educazione$landing_id) %>%
select(-landing_id)
if (filtro.anzianita != "All" | filtro.educazione != "All" | filtro.eta != "All" | filtro.ruolo != "All") {
m <- bind_rows(knowledge[1:2, ], m) %>%
select(-landing_id)
}
if (nrow(m) == 2) {
n <- ncol(knowledge) - 1
a <- as.tibble(matrix(rep(0, n), ncol = n))
colnames(a) <- colnames(knowledge)[2:ncol(knowledge)]
m <- bind_rows(knowledge[1:2, ], a) %>%
select(-landing_id)
}
a <- as.tibble(matrix(rep(0, ncol(m)), ncol = ncol(m)))
colnames(a) <- colnames(m)
for (i in colnames(m)) {
a[[i]] <- mean(m[[i]][3:nrow(m)])
}
m <- rbind(m, a)
m
})
output$radarBehaviours <- renderPlotly(
# newdarchart({filtered.attitude()}, axistype = 1,
# pcol=colors_border, pfcol=colors_in, plwd=4, plty=1, vlabels = colnames({filtered.attitude()}),
# cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(1,5,1), cglwd=1.5,
# vlcex = 0.8, title = "Attitude")
plot_ly(
type = 'scatterpolar',
fill = 'toself'
) %>%
add_trace(
r = as.numeric(unname(unlist({filtered.behaviours()}[nrow({filtered.behaviours()}),]))),
theta = colnames({filtered.behaviours()}),
name = 'Average',
color = I("lightgreen")
) %>%
add_trace(
r = as.numeric(unname(unlist(behaviours[behaviours$landing_id=={id()},2:ncol(behaviours)]))),
theta = colnames({filtered.behaviours()}),
name = 'Your Scores',
color = I("blue")
) %>%
layout(
polar = list(
radialaxis = list(
visible = T,
range = c(0,5)
)
),
title = "Culture and Behaviours",
margin = list(b = 50, l = 140)
)
)
output$radarKnowledge <- renderPlotly(
# newdarchart({filtered.attitude()}, axistype = 1,
# pcol=colors_border, pfcol=colors_in, plwd=4, plty=1, vlabels = colnames({filtered.attitude()}),
# cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(1,5,1), cglwd=1.5,
# vlcex = 0.8, title = "Attitude")
plot_ly(
type = 'scatterpolar',
fill = 'toself'
) %>%
add_trace(
r = as.numeric(unname(unlist({filtered.knowledge()}[nrow({filtered.knowledge()}),]))),
theta = colnames({filtered.knowledge()}),
name = 'Average',
color = I("lightgreen")
) %>%
add_trace(
r = as.numeric(unname(unlist(knowledge[knowledge$landing_id=={id()},2:ncol(knowledge)]))),
theta = colnames({filtered.knowledge()}),
name = 'Your Scores',
color = I("blue")
) %>%
layout(
polar = list(
radialaxis = list(
visible = T,
range = c(0,5)
)
),
title = "Knowledge and Tools",
margin = list(b = 50, l = 140)
)
)
output$sidebarpanel <- renderUI({
if (USER$login == TRUE ){
dashboardSidebar(
sidebarMenu(
convertMenuItem(menuItem("Summary: Click Here!", tabName = "summary", icon = icon("dashboard")), "summary"),
convertMenuItem(menuItem("Culture and Behaviours", tabName = "behaviours", icon = icon("chart-pie")), "behaviours"),
convertMenuItem(menuItem("Smart Resilience", tabName = "resilience", icon = icon("chart-pie")), "resilience"),
convertMenuItem(menuItem("Knowledge and Tools", tabName = "knowledge", icon = icon("chart-pie")), "knowledge"),
convertMenuItem(menuItem("Instructions", tabName = "instructions", icon = icon("fas fa-question")), "instructions")
# convertMenuItem(menuItem("Histograms", tabName = "histograms", icon = icon("chart-bar"),
# selectInput("skill.digital", "Digital Skill:",
# # choices=colnames(my.skills)[-1]),
# choices =
# union(
# c('Collaboration',
# 'Artificial Intelligence',
# 'Safety and Security',
# 'Information Processing',
# 'Problem Solving',
# 'Content Creation'),
# colnames({filtered.vertical.skills()})),
# ),
# selectInput("skill.attitude", "Attitude and Digital Behaviour:",
# choices=union(colnames(attitude)[-1],
# colnames(behaviours)[-1]))), "histograms")
),
# img(src='Logo.jpg', height='50', weight='50', style="display: block; margin-left: auto; margin-right: auto;")
dashboard_footer(href="https://www.kilpatrick-digital.com", src='Logo.png', label = "", width = "100%", height = "130px",
italic = TRUE, bold = TRUE,
style = "text-align:center; align: center; padding: 0px; margin: 0px;")
)}
})
output$body <- renderUI({
if (USER$login == TRUE){
tabItems(
# First tab content
tabItem(tabName = "summary",
fluidRow(
# h2("Executive Summary"),
valueBox(8, "Skills evaluated", icon=icon("user-check")),
#valueBox(nrow(behaviours) - 2, "Evaluated", icon=icon("user-check")),
valueBox(3, "Evaluated Areas", icon=icon("layer-group"), color = "purple"),
valueBox(nrow({risposte.reattive()}), "Questions", icon=icon("question"), color = "orange"),
# h2("Your results"),
column(width = 6,
valueBox(round(mean({risposte.reattive()}$Mark),2), "Your Total Score", icon=icon("dashboard"), color = case_when(mean({risposte.reattive()}$Mark)<=3 ~ "red",
mean({risposte.reattive()}$Mark)<=4 ~ "yellow",
TRUE ~ "green"),
width = "100%")),
# box(C3GaugeOutput("totalplot", width = "100%", height = "100px"), height = "120px", width = 3),
# C3GaugeOutput("totalplot", width = "30%", height = "100px"),
column(width = 6,
h2(sprintf('Hi %s', {nome()}), icon("far fa-smile-wink")),
br(),
strong({giudizio.complessivo()}, icon("fas fa-medal")),
br(),
p(paste0(sprintf("Your total score is %.2f, which compared to the best achievable is %.2f",
# c = 2,
# d = 3)))
a = round(mean({risposte.reattive()}$Mark),2),
b = (round(mean({risposte.reattive()}$Mark),2)/5)*100),"%")),
actionButton("info", "More Infos"),
br()
),
column(width = 12,
h2("Below you can see a summary of your results for each topic:"),
br()),
column(width = 12,
box(plotOutput(outputId = "summaryplot", width = "100%", height = "490px"), height = "505px"),
box(plotlyOutput(outputId = "distrubutionPlotPlot", width = "100%", height = "490px")), height = "550px")
#box(column(width = 12, DT::dataTableOutput("results"), style = "overflow-y: scroll;")), height = "550px")
# box(plotOutput(outputId = "summaryplot", width = "100%", height = "565px"), height = "580px"),
# box(column(width = 12, DT::dataTableOutput("results"), style = "overflow-y: scroll;"), height = "580px"))
)),
tabItem(tabName = "behaviours",
fluidRow(
column(3, selectInput("ruolo3", "Role:", c("All", "Board Member", "Manager", "Employee", "Consultant", "CxO/Executive"))),
column(3, selectInput("anzianita3", "Seniority:", c("All", "1-3 years", "4-8 years", "9-15 years", "more than 15 years"))),
column(3, selectInput("eta3", "Age:", c("All", "19-24", "25-34", "35-44", "45-54", "55-64", "65 or more"))),
column(3, selectInput("educazione3", "Education:", c("All", "Undergraduate", "Graduate", "MSc/MBA", "PhD"))),
# box(plotOutput("radarPlot", width = "100%")),
# box(plotOutput("newradarPlot", width = "100%"))
box(
conditionalPanel(condition = TRUE,
plotlyOutput(outputId = "radarBehaviours", width = "70%", height = "350px"),
align = "center")
# selectInput("attitudeBehaviours", "Dimension:", c("Attitude", "Digital Behaviours"))
),
box(
h3("Culture and Behaviours", icon("fas fa-users")),
# conditionalPanel(condition = TRUE,
# # tableOutput("radarPlot")
# plotlyOutput(outputId = "radarPlot", width = "70%", height = "350px"),
# align = "center")
br(),
strong({behaviours.giudizio()}),
br(),
p({behaviours.inglese()}),
br(),
p({behaviours.italiano()}),
height = "370px"
),
box(width = 12,
plotlyOutput("gapplotBehaviours", width = "100%"))
)
),
tabItem(tabName = "resilience",
fluidRow(
column(3, selectInput("ruolo", "Role:", c("All", "Board Member", "Manager", "Employee", "Consultant", "CxO/Executive"))),
column(3, selectInput("anzianita", "Seniority:", c("All", "1-3 years", "4-8 years", "9-15 years", "more than 15 years"))),
column(3, selectInput("eta", "Age:", c("All", "19-24", "25-34", "35-44", "45-54", "55-64", "65 or more"))),
column(3, selectInput("educazione", "Education:", c("All", "Undergraduate", "Graduate", "MSc/MBA", "PhD"))),
box(
conditionalPanel(condition = TRUE,
plotlyOutput(outputId = "radarResilience", width = "70%", height = "350px"),
align = "center")
),
box(
h3("Smart Resilience", icon("fas fa-swimmer")),
# conditionalPanel(condition = TRUE,
# # tableOutput("radarPlot")
# plotlyOutput(outputId = "radarPlot", width = "70%", height = "350px"),
# align = "center")
br(),
strong({resilience.giudizio()}),
br(),
p({resilience.inglese()}),
br(),
p({resilience.italiano()}),
height = "370px"
),
box(width = 12,
plotlyOutput("gapplotResilience", width = "100%"))
)
),
tabItem(tabName = "knowledge",
fluidRow(
column(3, selectInput("ruolo4", "Role:", c("All", "Board Member", "Manager", "Employee", "Consultant", "CxO/Executive"))),
column(3, selectInput("anzianita4", "Seniority:", c("All", "1-3 years", "4-8 years", "9-15 years", "more than 15 years"))),
column(3, selectInput("eta4", "Age:", c("All", "19-24", "25-34", "35-44", "45-54", "55-64", "65 or more"))),
column(3, selectInput("educazione4", "Education:", c("All", "Undergraduate", "Graduate", "MSc/MBA", "PhD"))),
# box(plotOutput("radarPlot", width = "100%")),
# box(plotOutput("newradarPlot", width = "100%"))
box(
conditionalPanel(condition = TRUE,
plotlyOutput(outputId = "radarKnowledge", width = "70%", height = "350px"),
align = "center")
),
box(
h3("Smart Resilience Knowledge and Tools", icon("fas fa-chalkboard-teacher")),
br(),
strong({knowledge.giudizio()}),
br(),
p({knowledge.inglese()}),
br(),
p({knowledge.italiano()}),
height = "370px"
),
box(width = 12,
plotlyOutput("gapplotKnowledge", width = "100%"))
)
),
tabItem(tabName = "instructions",
fluidRow(
box(
tags$head(tags$style(
type="text/css",
"#istruzioni img {max-width: 100%; width: 100%; height: auto}"
)),
tags$a(imageOutput("istruzioni")),
align = "center",
width = "100%",
height = "330px"
)
))
# Second tab content
# tabItem(tabName = "histograms",
# fluidRow(
# column(3, selectInput("ruolo2", "Role:", c("All", "Board Member", "Manager", "Employee", "Consultant", "CxO/Executive"))),
# column(3, selectInput("anzianita2", "Seniority:", c("All", "1-3 years", "4-8 years", "9-15 years", "more than 15 years"))),
# column(3, selectInput("eta2", "Age:", c("All", "19-24", "25-34", "35-44", "45-54", "55-64", "65 or more"))),
# column(3, selectInput("educazione2", "Education:", c("All", "Undergraduate", "Graduate", "MSc/MBA", "PhD"))),
# box(plotlyOutput("infoplot", width = "100%", height = "350px")),
# box(plotlyOutput("plot", width = "100%", height = "350px")),
# box(width = 12,
# plotlyOutput("barchart", width = "100%"))))
)
} else {
loginpage
}
})
updateTabItems(session, "tabs", "summary")
}