Chapter 11 Questionnaire and dashboard
설문지를 만드는 실습은 shinydashboard 쳅터에서 실습을 했었습니다. 이번에는 설문조사에서 나온 내용을 바로 그래프로 그려 알아보는 것을 실습하겠습니다. 또한 저번에 DB를 사용하는 실습을 하였는데 이를 종합해서 실습하겠습니다 . 즉, 이번 시간에는 shiny app으로 설문을 만들고, 이를 DB에 저장한다음, DB에서 데이터를 불러와서 현재의 점수와 DB에 쌓여 있는 점수를 비교하여 현재 설문자가 어느정도 수준인지를 확인하는 것입니다. 따라서 본 실습을 완료하면 shiny app, DB, visualization 에 대한 경험을 갖게 됩니다.
먼저 DB 와 설문지의 기본을 global변수에 만들겠습니다.
#load library
rm(list=ls())
pkgs = c("shinydashboard", "shinyWidgets", "tidyverse","ggplot2","plotly","readxl","DT", "DBI")
for (pkg in pkgs) {
if (pkg %in% rownames(installed.packages()) == FALSE)
{eval( bquote(install.packages(.(pkg))) )}
else
{eval(bquote(library(.(pkg))))}
}
# load secure key
seckey = readRDS('secure/dbsec.rds')
# db connection
con <- DBI::dbConnect(odbc::odbc(), Driver = "PostgreSQL Unicode",
Server = "localhost", Database = "ocdm",
UID = seckey$user, #rstudioapi::askForPassword("user") ,
PWD = seckey$pwd, #rstudioapi::askForPassword("password"),
Port = seckey$port) #rstudioapi::askForPassword("port"))
#dbSendStatement(con, "create schema surveyout")
#dbSendStatement(con, "drop table if exists surveyout.deps")
# custom function to save DB ---------
saveDB <- function(data){
dbWriteTable(con, SQL("surveyout.depression"), value = data, append = TRUE)
}
# data step
depression_total = dbGetQuery(con, "SELECT * from surveyout.depression")
depression_total_score <- depression_total %>%
mutate_at(vars(contains('rd')), list(~as.numeric(.))) %>%
mutate(depression_total_score = rowSums(across(rd1:rd9)))
#depression_total_score
q_depression <-list("1) 매사에 흥미나 즐거움이 거의 없었습니까?",
"2) 기분이 가라앉거나 우울하거나 희망이 없다고 느껴졌습니까?",
"3) 잠들기 어렵거나 자주깬다/ 혹은 잠을 너무 많이 잤습니까?",
"4) 피곤하다고 느끼거나 기운이 거의 없었습니까?",
"5) 식욕이 줄었다/혹은 너무 많이 먹었습니까?",
"6) 제 자신이 실패자로 여겨지거나, 가족을 실망시켰다고 느껴졌습니까?",
"7) 신문이나 TV를 보는 것과 같은 일상적인 일에 집중하기 어려웠습니까?",
"8) 다른 사람들이 눈치 챌 정도로, 평소보다 말과 행동이 느리거나 혹은 너무 안절부절해서 가만히 앉아 있을 수 없었습니까?",
"9) 차라리 죽는 것이 낫겠다고 생각하거나, 어떻게든 자해를 하려고 생각했습니까")
#버튼(bt), 점수(sc)
bt_depression <- c('전혀 없음',
'며칠동안',
'1주일 이상',
'거의 매일')
sc_depression <- c(0,1,2,3)
#결과 table
depression_table <- data.frame( '점수' = c("0~4점", "5~9점", "10~19점", "20점 이상"),
'내용' = c("우울증상 없음",
"가벼운 우울증상을 보이고 있으나, 심각한 수준으로 아닙니다. 스트레스 해소를 위한 운동 및 취미활동 등 자신만의 방법을 찾아보는 것이 추천됩니다.",
"중간 정도의 우울증상을 보이고 있습니다. 수면 부족, 식욕 변화 및 집중력 저하 등의 일상생활에 지장을 주고 있을 가능성이 있습니다. 전문가에게 상담 받아 보시기를 추천 드립니다.",
"심한 우울증상을 보이고 있으며, 적극적인 치료를 위해 정신건강의학과에 방문하시는 것이 필요합니다."
))
depression_html9 <-c('<b><font color =\"#FF0000"> 9번째 항목에 1점이상 체크시 </font> 정신건강의학 전문의 상담이 필요합니다.') # 색 강조 때문에이후 이를 표현하는 ui를 만들겠습니다. 박스를 3개 만들어서, 설문지, 개인결과, 비교결과 이렇게 구성했습니다.
# ui start -----------
ui = dashboardPage(
# header ------------
header = dashboardHeader(
title = ("우울증 설문")
),
# sidebar ----------
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("우울증", icon = icon("hand-holding-heart"), tabName="depression")
)
),
# body -----------
body = dashboardBody(
tabItems(
tabItem(tabName = 'depression',
fluidRow(box(width = 6, "안녕하세요 아래 설문 부탁드립니다.",
column(12,
sliderInput("age", "연령:",
min = 15, max = 75, value = 30, step =1),
radioButtons("gender", "성별:",
choiceNames = c("여자", "남자"),
choiceValues = c(1,2),
inline = TRUE),
textAreaInput("id", "이름 +핸드폰 뒷자리 4개(예, 윤진하2005"),
lapply(1:9, function(x){
radioButtons(paste0('rd',x), q_depression[[x]],
choiceNames = bt_depression, choiceValues = sc_depression, inline = TRUE)
}),
radioButtons("agree", "개인정보 사용하지 않습니다. 분석에 사용해도 될까요?",
choiceNames = c("네", "아니오"),
choiceValues = c(1,2),
inline = TRUE),
actionButton("submit_depression", "입력(아래확인)")
))
,
box(width =6, "개인 결과 입니다.",
htmlOutput("depression"),
htmlOutput("depression9"),
htmlOutput("depression_html9"),
tableOutput("depression_table"))
,
box(width = 6, "내 결과(점선)와 전체 집단 점수 분포",
plotlyOutput('depression_status_plot')
)
)
)
)
)
)서버를 만들겠습니다. 여기서 주목할 점은 renderplotly의 시각화와 여기에 depression_score()를 이용해서 현재의 값을 기존의 값과 비교했다는 것입니다 . 그리고 saveDB를 이용해서 설문지 값을 저장하고 있다는 것입니다 .
server <- function(input, output, session){
# depression score ---------------
observeEvent(input$submit_depression, {
depression_score <- reactive({
as.numeric(input$rd1) + as.numeric(input$rd2) +as.numeric(input$rd3) + as.numeric(input$rd4)+
as.numeric(input$rd5) + as.numeric(input$rd6)+as.numeric(input$rd7) + as.numeric(input$rd8)+
as.numeric(input$rd9)
})
output$depression <- renderText({
paste("당신의 점수는", depression_score(), "점")
})
output$depression9 <- renderText({
paste("당신의 9번 점수는", input$rd9, '점')
})
output$depression_html9 <- renderText(depression_html9)
output$depression_table <- renderTable(depression_table)
depression_datatable <- reactive({
data.frame(
't' = Sys.time(),
'id' = input$id,
'age'= input$age,
'gender'= input$gender,
'agree' = input$agree,
'rd1' = input$rd1,'rd2' = input$rd2, 'rd3' = input$rd3,
'rd4' = input$rd4, 'rd5' = input$rd5, 'rd6' = input$rd6,
'rd7' = input$rd7, 'rd8' = input$rd8, 'rd9' = input$rd9
)
})
output[['depression_status_plot']] <- renderPlotly({
ggplotly(
depression_total_score %>%
ggplot(aes(x = depression_total_score, fill = as.numeric(gender))) +
#geom_histogram(alpha = 0.7)+
geom_density(alpha = 0.4) +
theme_minimal()+
geom_vline(aes(xintercept = mean(depression_total_score)), color ='black', linetype=1)+
annotate("text", x = mean(depression_total_score$depression_total_score)+1, y=0.05,label ="mean", color="black" ) +
geom_vline(aes(xintercept = depression_score()), color ='red', linetype=2) +
annotate("text", x = depression_score()+2, y=0.07,label ="my score", color="red" )
)
})
saveDB(depression_datatable())
}
)
}
#11.1 과제
연령의 분포를 density plot으로 그리고, 여기에 현재 입력자의 연령을 표시하세요