• 沒有找到結果。

# 視覺化介面呈現

## 第八章 總結

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:

## 附錄 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,

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

#Sidebar content of the dashboard sidebar <- dashboardSidebar(

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(

h4("此筆資料紀錄 103 學年度(畢業後 1 年)、101 學年度(畢業後 3 年)、99 學年 度(畢業後五年)學生之流向調查。"),h3(strong("資料變數：")),

h4("姓名、學號、第 1 題、第 2 題、第 3 題、第 4 題、第 5 題、第 6 題、第 7 題、

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 =

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) {

dom = 'Blfrtip',buttons = c('copy', 'csv', 'excel', 'pdf', 'print' , 'colvis'),scrollX = TRUE, fixedColumns = TRUE,pageLength = nrow(a), fixedHeader = TRUE))

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 ))

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})

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)

header <- dashboardHeader(title = "教務處招生組行動平台", titleWidth = 260) sidebar <- dashboardSidebar(width = 260, collapsed = F,

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)

)})

output\$mymap1 <- renderLeaflet({

point.df1 <- data.frame(

lat = a1()\$lat, long = a1()\$lon)

)})

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)

Outline