第七章 招生問題視覺化界面
7.2 視覺化介面呈現
在此章節，我們將針對此問題使用R 語言中的“ShinyDashboard”套件做出一 個互動式介面。在此介面中將先進行基本介紹，隨後介紹上一章節中的各區比值算 法，最後為互動式視覺化地圖、圖表呈現，使用者在下拉式選單選擇學校後，下方 圖表將顯示使用者選擇學校後，呈現此校通過第一階段初選之學生的考場地點，及
來自北部、中部、南部考區與全台考生的比值之視覺化呈現圖形。圖7.2 為問題概
述及計算各地區比例之方法。
圖7.3 為使用者在下拉式選單選擇學校後，圖表將呈現此校通過第一階段初選 之學生來自北部、中部、南部考區與全台考生的比值、互動式地圖、各考生准考證 號碼…等資訊。
圖7.3 招生視覺化介面(二)
圖7.4 為使用者在下拉式選單選擇各校學系後，圖表將呈現此系所通過第一階
段初選之學生來自北部、中部、南部考區與全台考生的比值、互動式地圖、各考生 准考證號碼…等資訊。
圖7.4 招生視覺化介面(三)
第八章 總結
為統計與圖表打造的 R 程式語言，我們不需要使用不熟悉的網頁語言如 html、
JavaScript 等，此外應用程序能有效的將分析結果以互動式及視覺化的方式呈現給 使用者，對於不熟悉其他程式語言者或是統計分析不甚熟悉者呈現分析結果非常 有幫助。
參考文獻
[1] Agresti, A. (1990). Categorical Data Analysis. Wiley, New York.
[2] Friedman, J., Hastie, T. and Tibshirani, R. (2000). Additive logistic regression：A statistical view of boosting. Annals of Statistics, 28, 337-407.
[3] Friedman, J., Hastie, T. and Tibshirani, R. (2001). The Elements of Statistical
Learning：Data Mining, Inference, and Prediction. Springer, New York
[4] James, G., Witten, D., Hastie, T. and Tibshirani, R. (2013). An Introduction to
Statistical Learning: With Applications in R. Springer, New York
[5] Kutner, M. H., Nachtsheim, C. J. and Neter, J., Li, W. (2005). Applied Linear
Statistic Models. McGraw-Hill Higher Education
[6] Lantz, B. (2013). Machine Learning with R. Packt Publishing Ltd
[7] Mailund, T. (2017). Beginning Data Science in R: Data Analysis, Visualization, and
Modelling for the Data Scientist. Apress
[8] Montgomery, D. C., Peck, E. A. and Vining, G. G. (2001). Introduction to Linear
Regression Analysis. Wiley, New York
[9] Quinlan, J. R. (1986). Induction of decision trees. Machine Learning, 1, 81-106.
[10] Rahlf, T. (2017). Data Visualisation with R: 100 Examples. Springer
[11] Shumway, R. H. and Stoffer, D. S. (2011). Time Series Analysis and Its Applications:
With R Examples. Springer, New York
附錄 1.
#An Interactive Web Application of Data Science with R using Shiny library(shiny)
library(shinydashboard)
header <- dashboardHeader(title = "NAME", titleWidth = 260) sidebar <- dashboardSidebar(width = 260, collapsed = F,
sidebarMenu(menuItem("TITLE", tabName = "A1", icon = icon("th-list")))) body <- dashboardBody(
tabItems(
tabItem(tabName = "A1", )))
ui <- dashboardPage(header, sidebar, body) server <- function(input, output, session){
}
# Create Shiny app ---- shinyApp(ui, server)
附錄 2.
#Dashboard header carrying the title of the dashboard
header <- dashboardHeader(title = "高雄大學畢業生流向調查",titleWidth = 350)
#Sidebar content of the dashboard sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("98 學年畢業 5 年問卷", tabName = "graduate5", icon = icon("dashboard")), menuItem("98-104 學 年 度 學 生 成 績 資 料 ", tabName = "grade98104", icon = icon("dashboard")),
menuItem("問題 1", tabName = "question1", icon = icon("dashboard")), menuItem("問題 2", tabName = "question2", icon = icon("dashboard")), menuItem("問題 3", tabName = "question3", icon = icon("dashboard")) ))
body <- dashboardBody(
tabItems(
tabItem(tabName = "graduate5",h1(code("畢業生流向調查資")),
h4("此筆資料紀錄 103 學年度(畢業後 1 年)、101 學年度(畢業後 3 年)、99 學年 度(畢業後五年)學生之流向調查。"),h3(strong("資料變數：")),
h4("姓名、學號、第 1 題、第 2 題、第 3 題、第 4 題、第 5 題、第 6 題、第 7 題、
第8 題、第 9 題、第 10 題、第 11 題、第 12 題、第 13 題、無法填答原因。"), br(),h3(strong("問卷之格式如下圖：")),
fluidRow(box(width =4,height = 520,imageOutput("askQ1")), box(width =4,height = 520,imageOutput("askQ2")),
box(width =4,height = 520,imageOutput("askQ4"))), br(),
fluidRow(box(title = "畢業一年問卷問題如下：",width = 4,height =700 ,solidHeader = TRUE, status = "primary",h3(strong("第一部分")),
h4("一、 您目前的工作狀況為何？"),
h4("九、 您對目前工作的整體滿意度為何?"),
box(title = "畢業三年問卷問題如下：",width = 4,height =700 ,solidHeader = TRUE, status = "primary",h3(strong("第一部分")),
h4("一、 您目前的工作狀況為何？"),
box(title = "畢業五年問卷問題如下：",width = 4,height =700 ,solidHeader = TRUE, status = "primary",h3(strong("第一部分")),
h4("一、 您目前的工作狀況為何？"),
h4("十、 根據您畢業到現在的經驗，學校最應該幫弟妹加強以下哪些能力？"), h4("十一、 根據您畢業後到現在的經驗，認為學校對那些能力培養最有幫助？"), h4("十二、 如果您現在有進修機會的話，「最」想學校是哪一個門 ?"))),
br(),br(),
fluidRow(box(title = "畢業生流向調查資料",width =12,solidHeader = TRUE, status =
"primary", dataTableOutput(outputId = "askexample")))), tabItem(tabName = "grade98104",
h1(code("大學部歷年成績表(全) ")),
h4("此資料紀錄 98 學年度到 104 學年度之高雄大學學生各學期每門課之修課成 績，共 549983 筆。 "),h3(strong("資料變數：")),
h4("識別碼、學號、修課學年、修課學期、課程編號、開課系所、課程名稱、教師 員工編號、課程學分數、修課成績、 必修判別碼、必選修。"),
br(), br(), br(),
fluidRow(box(title = "98-104 學年度學生成績資料範例",width =12,solidHeader = TRUE, status = "primary", dataTableOutput(outputId = "gradeexample")))),
tabItem(tabName = "question1",
fluidRow( box(title = "各系所薪資中位數",width =6,height =460, solidHeader = TRUE, status = "primary",dataTableOutput(outputId = "Table1")),box(title = " 各 系 所 薪 資 Boxplot",width =6,height =460,solidHeader = TRUE, status = "primary", plotlyOutput("trendPlot"))),fluidRow(box(width =4,height =100,selectInput("select1", label=h6("選擇系所"), choices=c("人文院","法院","管院","理院","工學院"))),
box(width =4,height =100,selectInput("select2",label=h6("選擇系所"), choices=c("人文 院","法院","管院","理院","工學院"))),valueBoxOutput("vbox", width = 4)),
fluidRow(box(title = "各系所薪資中位數檢定",width =6, height =200,solidHeader = TRUE, status = "primary",verbatimTextOutput("test1")))),
tabItem(tabName = "question2", fluidRow(
box(title = "各地區薪資中位數",width =6,height =460, solidHeader = TRUE, status =
"success",dataTableOutput(outputId = "Table2")),
box(title = "各地區薪資中位數",width =6,height =460, solidHeader = TRUE, status =
"success", plotlyOutput("trendPlot1"))),
box(width =4,height = 450,imageOutput("NORTH")), box(width =4,height = 450,imageOutput("MID")), box(width =4,height = 450,imageOutput("SOUTH")), fluidRow(
valueBoxOutput("vbox_area1", width = 4), valueBoxOutput("vbox_area2", width = 4), valueBoxOutput("vbox_area3", width = 4)),
fluidRow( box(title = "北部 v.s 中部",width =4,height =220, solidHeader = TRUE, status = "success", verbatimTextOutput("test_area1")),
box(title = "中部 v.s 南部",width =4,height =220, solidHeader = TRUE, status =
"success", verbatimTextOutput("test_area2")),
box(title = "北部 v.s 南部",width =4,height =220, solidHeader = TRUE, status =
h4("L1 : 溝通表達能力 L2 : 持續學習能力 L3 : 人際互動能力"), h4("L4 : 團隊合作能力 L5 : 問題解決能力 L6 : 創新能力"),
h4("L7 : 工作紀律、責任感及時間管理能力 L8 : 資訊科技應用能力 "), h4("L9 : 外語能力 L10 : 跨領域整合能力 L11 : 領導能力"),
fluidRow( box(title = "HCLUST 分組",width =6,height = 500,solidHeader = TRUE, status = "primary",imageOutput("ABLITI")), box(title = "分組結果",width =6,height = 500,solidHeader = TRUE, status = "primary", dataTableOutput(outputId =
"hamdisresult"))),
fluidRow( box(width =6,height = 600,imageOutput("G1G4")), box(width =6,height = 600,imageOutput("G5G7"))),
fluidRow(box(width =4,height =100,selectInput("select3", label=h6(" 選 擇 分 組 "), choices=c("第一組"=1,"第二組"=2,"第三組"=3,"第四組"=4,"第五組"=5,"第六組
"=6,"第七組"=7))), box(width =4,height =100,selectInput("select4",label=h6("選擇分 組"), choices=c("第一組"=1,"第二組"=2,"第三組"=3,"第四組"=4,"第五組"=5,"第六 組"=6,"第七組"=7))), valueBoxOutput("vbox1", width = 4)),
fluidRow(box(title = "各組薪資中位數檢定",width =6, height =200,solidHeader = TRUE, status = "primary",verbatimTextOutput("test3"))))))
ui <- dashboardPage(title = 'This is my Page title', header, sidebar, body, skin='blue') server <- shinyServer(function(input, output) {
output$askexample <- renderDataTable(
data_ask_example, filter=c("top"),extensions=c('Buttons','FixedColumns','FixedHeader'), options = list(
dom = 'Blfrtip',buttons = c('copy', 'csv', 'excel', 'pdf', 'print' , 'colvis'),scrollX = TRUE, fixedColumns = TRUE,pageLength = nrow(a), fixedHeader = TRUE))
output$gradeexample <- renderDataTable(
data_grade, filter = c("top") , extensions = c('Buttons','FixedColumns','FixedHeader'), options = list(dom = 'Blfrtip',buttons = c('copy', 'csv', 'excel', 'pdf', 'print' , 'colvis'), scrollX = TRUE, fixedColumns = TRUE,pageLength = nrow(a), fixedHeader = TRUE ))
output$hamdisresult <- renderDataTable(
hamdi, filter = c("top") , extensions = c('Buttons','FixedColumns','FixedHeader'), options
= list(dom = 'Blfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print' , 'colvis'),
scrollX = TRUE,fixedColumns = TRUE,pageLength = nrow(a), fixedHeader = TRUE ))
output$askQ1 <- renderImage({
list(src = "Q1.png",contentType = 'image/png')}, deleteFile = FALSE) output$askQ2 <- renderImage({
list(src = "Q2.png",contentType = 'image/png')}, deleteFile = FALSE) output$askQ4 <- renderImage({
list(src = "Q4.png",contentType = 'image/png')}, deleteFile = FALSE) output$hamdis <- renderImage({
list(src = "Q4.png",contentType = 'image/png')}, deleteFile = FALSE) output$ABLITI <- renderImage({
list(src = "hamdis.png",contentType = 'image/png')}, deleteFile = FALSE)
output$G1G4<- renderImage({
list(src = "G1TOG4.png",contentType = 'image/png')}, deleteFile = FALSE)
output$G5G7 <- renderImage({
list(src = "G5TOG7.png",contentType = 'image/png')}, deleteFile = FALSE) output$trendPlot1 <- renderPlotly({
p <- ggplot(dat1_area , aes(x=place, y=money , fill=place)) + geom_boxplot() p <- ggplotly(p)
p})
output$trendPlot <- renderPlotly({
p <- ggplot(dat1 , aes(x=class, y=money , fill=class)) + geom_boxplot() p <- ggplotly(p)
p})
table1 <- read.csv("Table(系所).csv",header = T) output$Table1 <- renderDataTable(table1) table2 <- read.csv("dataarea.csv",header = T) output$Table2 <- renderDataTable(table2) testdat1 <- reactive({
s1 <- as.character(input$select1)
tesdat1<- dataBBF3[which(dataBBF3[,26] == s1),]
a1 <- tesdat1[,6]
a1})
testdat2 <- reactive({
s2 <- as.character(input$select2)
tesdat2 <- dataBBF3[which(dataBBF3[,26] == s2),]
a2 <- tesdat2[,6]
a2})
testdat3 <- reactive({
s3 <- as.numeric(input$select3)
tesdat3 <- data_ham[which(data_ham[,2] == s3),]
a3 <- tesdat3[,3]
a3})
testdat4 <- reactive({
s4 <- as.numeric(input$select4)
tesdat4 <- data_ham[which(data_ham[,2] == s4),]
a4 <- tesdat4[,3]
a4})
output$test1 <-renderPrint({
wilcox.test(testdat1(),testdat2())}) output$test3 <-renderPrint({
wilcox.test(testdat3(),testdat4())}) output$vbox <- renderValueBox({
h <- wilcox.test(testdat1(),testdat2())
valueBox(value = tags$p(round(h$p.value,8), style = "font-size: 150%;"),
subtitle = tags$p("Wilcox.Test", style = "font-size: 150%;"),icon = icon("credit-card")) })
subtitle = tags$p("Wilcox.Test", style = "font-size: 150%;"),icon = icon("credit-card")) })
output$test_area1 <-renderPrint({
wilcox.test(a1_area$第 5 題,b1_area$第 5 題)}) output$test_area2 <-renderPrint({
wilcox.test(b1_area$第 5 題,c1_area$第 5 題)}) output$test_area3 <-renderPrint({
wilcox.test(a1_area$第 5 題,c1_area$第 5 題)}) output$vbox_area1 <- renderValueBox({
h_area1 <- wilcox.test(a1_area$第 5 題,b1_area$第 5 題)
valueBox("Wilcox.Test(北部 v.s 中部)",round( h_area1$p.value ,8), icon = icon("product-hunt"),color = "aqua")})
output$vbox_area2 <- renderValueBox({
h_area2 <- wilcox.test(b1_area$第 5 題,c1_area$第 5 題)
valueBox("Wilcox.Test(中部 v.s 南部)",round( h_area2$p.value ,8), icon = icon("product-hunt"),color = "teal")})
output$vbox_area3 <- renderValueBox({
h_area3 <- wilcox.test(a1_area$第 5 題,c1_area$第 5 題)
valueBox("Wilcox.Test(北部 v.s 南部)",round( h_area3$p.value ,8), icon = icon("product-hunt"),color = "olive")})
output$NORTH <- renderImage({
list(src = "北部工作.png",contentType = 'image/png')}, deleteFile = FALSE) output$MID <- renderImage({
list(src = "中部工作.png",contentType = 'image/png')}, deleteFile = FALSE) output$SOUTH <- renderImage({
list(src = "南部工作.png",contentType = 'image/png')}, deleteFile = FALSE)})
#run/call the shiny app shinyApp(ui, server)
附錄 3.
#An Interactive Web Application of Data Science with R using Shiny library(readxl)
a7 <- fread("final5.csv",header = T) a7$school = as.character(a7$school) a7$depart = as.character(a7$depart)
header <- dashboardHeader(title = "教務處招生組行動平台", titleWidth = 260) sidebar <- dashboardSidebar(width = 260, collapsed = F,
sidebarMenu(menuItem("個人申請", tabName = "A1", icon = icon("th-list")) ))
body <- dashboardBody(
tabItems(
tabItem(tabName = "A1",
h2(strong("學校招生是否嚴重南偏?")),
box(width =6,height = 380,imageOutput("calculate1")), box(width =6,height = 380,imageOutput("calculate2"))), fluidRow(
box(width=3,solidHeader = TRUE, status = "info",height = 130, selectInput("select2", label=h3("學校"),
"primary"),
box(title = "各校分發結果學生地點比例",width = 4,height = 550,solidHeader = TRUE, status = "info",plotOutput("triplot")),
box(title = "各校分發結果學生地點比例",width = 4,height = 550,solidHeader = TRUE, status = "info",dataTableOutput(outputId = "schoolstu"))),
fluidRow(
box(title = " 學 系 ",width=3,solidHeader = TRUE, status = "danger",height = 150, uiOutput("derart")),
valueBoxOutput("vbox4", width = 3), valueBoxOutput("vbox5", width = 3), valueBoxOutput("vbox6", width = 3)), fluidRow(
box(title = "各校系所學生通過第一階段分佈",width = 4,height = 550,solidHeader = TRUE, status = "danger", leafletOutput("mymap")),
#box(title = "各校系所學生分發結果分佈",width = 4,solidHeader = TRUE, status =
"primary"),
box(title = "各校系所分發結果學生地點比例",width = 4,height = 550,solidHeader = TRUE, status = "danger",plotOutput("triplot1")),
box(title = "各校系所分發結果學生地點比例",width = 4,height = 550,solidHeader = TRUE, status = "danger", dataTableOutput(outputId = "departstu"))))))
ui <- dashboardPage(header, sidebar, body) server <- function(input, output, session){
a1 <- reactive({
a <- as.character(input$select2) a8 <- a7[which(a7[,1]==a)]
a8})
a2 <- reactive({
f <- a1()
b <- input$select_der b <- as.character(b) a9 <- f[which(f[,2]==b),]
a9})
output$schoolstu <- renderDataTable(
a1()[,c(1,2,4)], filter = c("top") , extensions = c('Buttons','FixedColumns','FixedHeader'),class = 'cell-border stripe', options = list(pageLength = 5, dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print' , 'colvis'),
scrollX = TRUE,fixedColumns = TRUE, pageLength = nrow(a), fixedHeader = TRUE))
output$departstu <- renderDataTable(
a2()[,c(1,2,4)], filter = c("top") , extensions = c('Buttons','FixedColumns','FixedHeader'),class = 'cell-border stripe', options = list(pageLength = 5,dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print' , 'colvis'),
scrollX = TRUE, fixedColumns = TRUE, pageLength = nrow(a), fixedHeader = TRUE))
a3 <- reactive({
a = nrow(a1())
n = sum(a1()[,10] == "北部") m = sum(a1()[,10] == "中部") s = sum(a1()[,10] == "南部") n1 = (n/a)/(0.5212804) m1 = (m/a)/(0.2598287) s1 = (s/a)/(0.2188909) d = matrix(c(n1,m1,s1),1,3) d})
a3 <- reactive({
a = nrow(a1())
n = sum(a1()[,10] == "北部") m = sum(a1()[,10] == "中部") s = sum(a1()[,10] == "南部") n1 = (n/a)/(0.5212804) m1 = (m/a)/(0.2598287) s1 = (s/a)/(0.2188909) d = matrix(c(n1,m1,s1),1,3) d})
a4 <- reactive({
a = nrow(a2())
d1 = matrix(c(n1,m1,s1),1,3) d1})
output$triplot <- renderPlot({
e = a3() a = e[,1]
b = e[,2]
c = e[,3]
plot(0,1, ann = F, bty = "n", xaxt = "n", yaxt ="n",xlim = c(-3.5,3.5),ylim=c(-2,5))
points(x=c(0,sqrt(3),0,0,-sqrt(3),0,sqrt(3),-sqrt(3)),y=c(3,0,1,3,0,1,0,0),col="red",pch=16,type = "l",lty=2,lwd=2)
points(x=c(0,b*sqrt(3),-c*sqrt(3),0),y=c(1+2*a,1-b,1-c,1+2*a),col="blue",pch=16,type
= "l",lty=1,lwd=3)
e = a4() a = e[,1]
b = e[,2]
c = e[,3]
plot(0,1, ann = F, bty = "n", xaxt = "n", yaxt ="n",xlim = c(-3.5,3.5),ylim=c(-2,5))
points(x=c(0,sqrt(3),0,0,-sqrt(3),0,sqrt(3),-sqrt(3)),y=c(3,0,1,3,0,1,0,0),col="red",pch=16,type = "l",lty=2,lwd=2)
points(x=c(0,b*sqrt(3),-c*sqrt(3),0),y=c(1+2*a,1-b,1-c,1+2*a),col="blue",pch=16,type
= "l",lty=1,lwd=3)
text(x=c(0,sqrt(3)+0.3,-sqrt(3)-0.3),y=c(3+0.3,0,0),c("北","中","南")) })
output$derart <-renderUI({
selectInput("select_der","系所",choices =as.list(unique(a1()$depart))) })
output$mymap <- renderLeaflet({
point.df <- data.frame(
lat = a2()$lat, long = a2()$lon)
leaflet(point.df) %>% addTiles() %>% addMarkers(clusterOptions = markerClusterOptions()
)})
output$mymap1 <- renderLeaflet({
point.df1 <- data.frame(
lat = a1()$lat, long = a1()$lon)
leaflet(point.df1) %>% addTiles() %>% addMarkers(clusterOptions = markerClusterOptions()
)})
output$vbox1 <- renderValueBox({
a <- as.character(input$select2) e = a3()
valueBox(value = tags$p(round(e[,1],3), style = "font-size: 150%;"),
subtitle = tags$p(paste(a,"學生北部比例",sep=""), style = "font-size: 150%;"),icon = icon("location-arrow"))})
output$vbox2 <- renderValueBox({
a <- as.character(input$select2) e = a3()
valueBox(value = tags$p(round(e[,2],3), style = "font-size: 150%;"),
subtitle = tags$p(paste(a,"學生中部比例",sep=""), style = "font-size: 150%;"),icon = icon("location-arrow"))})
output$vbox3 <- renderValueBox({
e = a3()
a <- as.character(input$select2)
valueBox(value = tags$p(round(e[,3],3), style = "font-size: 150%;"),
subtitle = tags$p(paste(a,"學生南部比例",sep=""), style = "font-size: 150%;"),icon = icon("location-arrow"))})
output$vbox4 <- renderValueBox({
a <- as.character(input$select2)
b <- input$select_der e = a4()
valueBox(value = tags$p(round(e[,1],3), style = "font-size: 160%;"),
subtitle = tags$p(paste(a,b," 北 部 比 例 ",sep=""), style = "font-size: 130%;"),icon = icon("location-arrow"),color = 'red')})
output$vbox5 <- renderValueBox({
a <- as.character(input$select2) b <- input$select_der
e = a4()
valueBox(value = tags$p(round(e[,2],3), style = "font-size: 160%;"),
subtitle = tags$p(paste(a,b," 北 部 比 例 ",sep=""), style = "font-size: 130%;"),icon = icon("location-arrow"),color = 'red')})
output$vbox6 <- renderValueBox({
a <- as.character(input$select2) b <- input$select_der
e = a4()
valueBox(value = tags$p(round(e[,3],3), style = "font-size: 160%;"),
subtitle = tags$p(paste(a,b," 北 部 比 例 ",sep=""), style = "font-size: 130%;"),icon = icon("location-arrow"),color = 'red')})
output$calculate1 <- renderImage({
list(src = "計算標準 1.png",contentType = 'image/png')}, deleteFile = FALSE) output$calculate2 <- renderImage({
list(src = "計算標準 2.png",contentType = 'image/png')}, deleteFile = FALSE)}
# Create Shiny app shinyApp(ui, server)