Below are the solutions to these exercises on Building Shiny App.
#################### # # # Exercise 1 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 2 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenuOutput("messageMenu" )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 3 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenuOutput("messageMenu" )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R messageData <- data.frame( from = c("Admininstrator", "New User", "Support"), message = c( "Sales are steady this month.", "How do I register?", "The new server is ready." ), stringsAsFactors = FALSE ) shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 4 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenuOutput("messageMenu" )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R messageData <- data.frame( from = c("Admininstrator", "New User", "Support"), message = c( "Sales are steady this month.", "How do I register?", "The new server is ready." ), stringsAsFactors = FALSE ) shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) output$messageMenu <- renderMenu({ # Code to generate each of the messageItems here, in a list. messageData # is a data frame with two columns, 'from' and 'message'. # Also add on slider value to the message content, so that messages update. msgs <- apply(messageData, 1, function(row) { messageItem( from = row[["from"]], message = paste(row[["message"]], input$slider) ) }) dropdownMenu(type = "messages", .list = msgs) }) }) #################### # # # Exercise 5 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) ), dropdownMenu(type = "notifications", notificationItem( text = "5 new users today", icon("users") ), notificationItem( text = "12 items delivered", icon("truck"), status = "success" ), notificationItem( text = "Server load at 86%", icon = icon("exclamation-triangle"), status = "warning" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 6 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) ), dropdownMenu(type = "notifications", notificationItem( text = "5 new users today", icon("users") ), notificationItem( text = "12 items delivered", icon("truck"), status = "success" ), notificationItem( text = "Server load at 86%", icon = icon("exclamation-triangle"), status = "warning" ) ), dropdownMenu(type = "tasks", badgeStatus = "success", taskItem(value = 90, color = "green", "Documentation" ), taskItem(value = 17, color = "aqua", "Project Iris" ), taskItem(value = 75, color = "yellow", "Server deployment" ), taskItem(value = 80, color = "red", "Overall project" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 7 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(disable=TRUE,title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) ), dropdownMenu(type = "notifications", notificationItem( text = "5 new users today", icon("users") ), notificationItem( text = "12 items delivered", icon("truck"), status = "success" ), notificationItem( text = "Server load at 86%", icon = icon("exclamation-triangle"), status = "warning" ) ), dropdownMenu(type = "tasks", badgeStatus = "success", taskItem(value = 90, color = "green", "Documentation" ), taskItem(value = 17, color = "aqua", "Project Iris" ), taskItem(value = 75, color = "yellow", "Server deployment" ), taskItem(value = 80, color = "red", "Overall project" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", h2("K-MEANS"), fluidRow( box(plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(),main = "K-MEANS", col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 8 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) ), dropdownMenu(type = "notifications", notificationItem( text = "5 new users today", icon("users") ), notificationItem( text = "12 items delivered", icon("truck"), status = "success" ), notificationItem( text = "Server load at 86%", icon = icon("exclamation-triangle"), status = "warning" ) ), dropdownMenu(type = "tasks", badgeStatus = "success", taskItem(value = 90, color = "green", "Documentation" ), taskItem(value = 17, color = "aqua", "Project Iris" ), taskItem(value = 75, color = "yellow", "Server deployment" ), taskItem(value = 80, color = "red", "Overall project" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(title="DATA TABLE",dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(title="SUMMARY DATA TABLE",dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", fluidRow( box(title="K-MEANS",plotOutput("plot1",click = "mouse")), box(sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(), col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 9 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) ), dropdownMenu(type = "notifications", notificationItem( text = "5 new users today", icon("users") ), notificationItem( text = "12 items delivered", icon("truck"), status = "success" ), notificationItem( text = "Server load at 86%", icon = icon("exclamation-triangle"), status = "warning" ) ), dropdownMenu(type = "tasks", badgeStatus = "success", taskItem(value = 90, color = "green", "Documentation" ), taskItem(value = 17, color = "aqua", "Project Iris" ), taskItem(value = 75, color = "yellow", "Server deployment" ), taskItem(value = 80, color = "red", "Overall project" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(title="DATA TABLE",status="primary",dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(title="SUMMARY DATA TABLE",status="primary",dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", fluidRow( box(title="K-MEANS",status="primary",plotOutput("plot1",click = "mouse")), box(status="warning",sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(status="warning",checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(status="warning",selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server.R shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(), col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) }) #################### # # # Exercise 10 # # # #################### #ui.r library(shiny) library(shinydashboard) dashboardPage( dashboardHeader(title = "Shiny App", dropdownMenu(type = "messages", messageItem( from = "Bob Carter", message = "Excellent dashboard.Keep the good job" ), messageItem( from = "New User", message = "How do I register?", icon = icon("question"), time = "23:00" ), messageItem( from = "Support", message = "The new server is ready.", icon = icon("life-ring"), time = "2017-15-03" ) ), dropdownMenu(type = "notifications", notificationItem( text = "5 new users today", icon("users") ), notificationItem( text = "12 items delivered", icon("truck"), status = "success" ), notificationItem( text = "Server load at 86%", icon = icon("exclamation-triangle"), status = "warning" ) ), dropdownMenu(type = "tasks", badgeStatus = "success", taskItem(value = 90, color = "green", "Documentation" ), taskItem(value = 17, color = "aqua", "Project Iris" ), taskItem(value = 75, color = "yellow", "Server deployment" ), taskItem(value = 80, color = "red", "Overall project" ) )), dashboardSidebar( sidebarMenu( menuItem("DATATABLE", tabName = "dt", icon = icon("dashboard")), menuItem("SUMMARY", tabName = "sm", icon = icon("th")), menuItem("K-MEANS", tabName = "km", icon = icon("th")) )), dashboardBody( tabItems( tabItem(tabName = "dt", h2("DATA TABLE"), fluidRow( box(title="DATA TABLE",solidHeader = TRUE,status="primary",dataTableOutput("Table"),width = 400) )), tabItem(tabName = "sm", h2("SUMMARY"), fluidRow( box(title="SUMMARY DATA TABLE",solidHeader = TRUE,status="primary",dataTableOutput("Table2"),width = 400) ) ), tabItem(tabName = "km", fluidRow( box(title="K-MEANS",solidHeader = TRUE,status="primary",plotOutput("plot1",click = "mouse")), box(status="warning",sliderInput("slider1", label = h4("Clusters"), min = 1, max = 9, value = 4), verbatimTextOutput("coord"))), fluidRow( box(status="warning",checkboxGroupInput("checkGroup", label = h4("Variable X"),names(iris), selected=names(iris)[[2]] )), box(status="warning",selectInput("select", label = h4("Variable Y"), names(iris),selected=names(iris)[[2]] ))) ) ) ) ) #server shinyServer(function(input, output) { output$Table <- renderDataTable( iris,options = list( lengthMenu = list(c(10, 20, 30,-1),c('10','20','30','ALL')), pageLength = 10)) sumiris<-as.data.frame.array(summary(iris)) output$Table2 <- renderDataTable(sumiris) output$plot1 <- renderPlot({ palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) plot(Data(), col = Clusters()$cluster, pch = 20, cex = 3, cex.main = 2, font.main= 4, col.main= "blue") }, width = "auto",height = "auto") output$coord <- renderText({ paste0("x=", input$mouse$x, "\ny=", input$mouse$y) }) Data <- reactive({iris[, c(input$select,input$checkGroup)] }) Clusters <- reactive({ kmeans(Data(),input$slider1) }) })
Leave a Reply