R-exercises

Train like you fight, fight like you train

Header Right

Main navigation

You are here: Home / Solutions / Building Shiny App Solutions (part-9)

Building Shiny App Solutions (part-9)

by Leave a Comment

Difficulty level: Not rated yet

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

What's next:

Please help us to improve R-exercises:

Related exercise sets:

Building Shiny App exercises part 10 Building Shiny App exercises part 3 Building Shiny App exercises part 7 Building Shiny App exercises part 1 Building Shiny App exercises part 2

Reader Interactions

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Become a Top R Programmer Fast with our Individual Coaching Program Learn More
(Advertisement) Online Master of Computer Science in Data Science (Univ of Illinois) Deadline Oct 15 Learn More