Skip to content

Shiny apps and exploration in using Shiny to build dashboards for data analysis and machine learning.

Notifications You must be signed in to change notification settings

shrysr/shiny-exploration

Repository files navigation

Introduction

This repo will serve as a learning and exploration ground to build shiny apps from the ground-up and evolve into my own app showcase. It will include references, notes and the scripts to reproduce the apps.

Planned Approach:

  • Re-implement examples that I find from scratch, and in parallel explore other aspects and variations of the code.
  • Apply the concepts learned to develop my own shiny apps.

Tools used:

  • Emacs and Org-mode (source blocks in Org-babel) have been used to create this document and all the source code. My notes live right alongside the code. a.k.a Literate programming at it’s finest. Unfortunately, this also means that you will have to scroll down a bit for reading specific notes. Original apps by me are placed upfront in the documentation and the recreations are grouped together.
  • My custom docker image is used to run shiny server in a docker container and render the apps. This ensures a standard environment for my datascience projects, as explained in my project.

References

The references below were instrumental in the learning procedure and also function as a source of inspiration.

Note: Relevant references and links are also placed alongside the code in each section.

  1. Rstudio documentation link
    • Free video tutorials from Datacamp sponsored by Rstudio. There are links to advanced articles, as well as written tutorials. This is a good resource to get started.
  2. Sales revenue dashboard with Rshiny and ShinyDashboard link

Fed R&D Spending on Climate change

App description and readme

Title: Internal dataset explorer for R
Author: Shreyas
AuthorUrl: https://shreyas.ragavan.co
License: MIT
DisplayMode: Showcase
Tags: getting-started
Type: Shiny
This app provids a quick overview of the info for all the inbuilt datasets in R. It can also pull in datasets referenced from the repository

Shiny App

Loading libraries

# Loading and installing libraries
library("easypackages")
packages("tidyverse",
         "tidyquant",
         "readxl",
         "shiny",
         "shinydashboard",
         "DT",
         "inspectdf",
         "DataExplorer")

UI

header

header <- dashboardHeader(title= "Federal R&D spending on Climate Change" )

sidebar

sidebar <- dashboardSidebar(
    sidebarMenu(
      menuItem("In-built data sets",
               tabName = "inbuilt_datasets",
               icon = icon("dashboard")
               ),
      menuItem("Rdatasets",
               tabName = "rdatasets",
               icon = icon("dashboard")
               )
    )
)

body

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "inbuilt_datasets",
      fluidRow(

        box(title = "Select Dataset",
            selectInput("dataset",
                        label = "Select Dataset",
                        choices = c(ls("package:datasets") ,
                                    data(package = "MASS")$results %>%
                                                          as.tibble %>%
                                                          .$Title
                                    )
                        )
           ),

        box(title = "Summary",
            verbatimTextOutput("summary"),
            fluidRow(
              box(
                title = "Data Glimpse",
                verbatimTextOutput("glimpse")
              )
            ),
            fluidRow(
              box(
                title = "Data HOE",
                renderPlot("inspectdf_types")
              )
            )
        )
      )
      )
     )
)

Assigning UI

ui  <- dashboardPage(header, sidebar, body)

Server

## Define server logic

server <- function(input, output){

  output$summary = renderPrint({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    summary(dataset)
  })

  ## output$table = renderTable({
  ##   dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
  ##   dataset
  ## })

  output$glimpse = renderPrint({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    glimpse(dataset)
  })

  output$inspectdf_types = renderPlot({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    inspect_cat2(as.data.frame(dataset)) %>% show_plot()
  })
}

App

## Run the app
shinyApp(ui = ui, server = server)

Dataset exploration app [0/1]

App description and readme

Title: Internal dataset explorer for R
Author: Shreyas
AuthorUrl: https://shreyas.ragavan.co
License: MIT
DisplayMode: Showcase
Tags: getting-started
Type: Shiny
This app provids a quick overview of the info for all the inbuilt datasets in R. It can also pull in datasets referenced from the repository

Using the Dashboard library

Loading libraries

# Loading and installing libraries
library("easypackages")
packages("tidyverse",
         "tidyquant",
         "readxl",
         "shiny",
         "shinydashboard",
         "ISLR",
         "MASS",
         "DT",
         "inspectdf",
         "DataExplorer")

UI

header

header <- dashboardHeader(title= "R Data set explorer")

sidebar

sidebar <- dashboardSidebar(
    sidebarMenu(
      menuItem("In-built data sets",
               tabName = "inbuilt_datasets",
               icon = icon("dashboard")
               ),
      menuItem("Rdatasets",
               tabName = "rdatasets",
               icon = icon("dashboard")
               )
    )
)

body

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "inbuilt_datasets",
      fluidRow(

        box(title = "Select Dataset",
            selectInput("dataset",
                        label = "Select Dataset",
                        choices = c(ls("package:datasets") ,
                                    data(package = "MASS")$results %>%
                                                          as.tibble %>%
                                                          .$Title
                                    )
                        )
           ),

        box(title = "Summary",
            verbatimTextOutput("summary"),
            fluidRow(
              box(
                title = "Data Glimpse",
                verbatimTextOutput("glimpse")
              )
            ),
            fluidRow(
              box(
                title = "Data HOE",
                renderPlot("inspectdf_types")
              )
            )
        )
      )
      )
     ) ##,
  ## tabItem(
  ##   tabName = "rdatasets",
  ##   h2("Rdatasets"),
  ##   fluidRow(

  ##     box(title = "Input",
  ##         selectInput("rdataset",
  ##                     label = "Select from RDatasets",
  ##                     choices = data(package = "MASS")$results %>%
  ##                                                     as.tibble %>%
  ##                                                     .$Title
  ##                       ),

  ##     box(title = "Summary",
  ##           verbatimTextOutput("summary_rdatasets"),
  ##           fluidRow(
  ##             box(
  ##           title = "Data Glimpse"),
  ##         verbatimTextOutput("glimpse_rdatasets")
  ##         )
  ##         )
  ##   )
  ## )
  ## )
)

Assigning UI

ui  <- dashboardPage(header, sidebar, body)

Server

## Define server logic

server <- function(input, output){

  output$summary = renderPrint({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    summary(dataset)
  })

  ## output$table = renderTable({
  ##   dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
  ##   dataset
  ## })

  output$glimpse = renderPrint({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    glimpse(dataset)
  })

  output$inspectdf_types = renderPlot({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    inspect_cat2(as.data.frame(dataset)) %>% show_plot()
  })
}

App

## Run the app
shinyApp(ui = ui, server = server)

Simple Layout - In built R Data Explorer

  • Note taken on [2019-02-05 Tue 09:20]
    Appears that the sidepanel and mainpanel concepts cannot be used with fluidRow() as subcomponents. Instead, it is possible to use only fluidRow() to partition the page, and use it to create individual rows within a column. Perhaps this is more flexible in the long run.
library("easypackages")
libraries("shiny", "tidyverse")

## Define UI
ui  <- fluidPage(
    titlePanel("R's in-built Database explorer"),

  fluidRow(
    column(2,
           "Input",
           selectInput("dataset",
                       label = "Select Dataset",
                       choices = ls("package:datasets")
                       )
           ),
    column(10,
           verbatimTextOutput("summary"),
           fluidRow(
             verbatimTextOutput("glimpse")
                         ))
    )
)

## Define server logic

server <- function(input, output){

  output$summary = renderPrint({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    summary(dataset)
  })

  output$table = renderTable({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    dataset
  })

  output$glimpse = renderPrint({
    dataset <- get(input$dataset, "package:datasets", inherits = FALSE)
    glimpse(dataset)
  })

}

## Run the app
shinyApp(ui = ui, server = server)

Shiny app around Rdatasets

Introduction

Resources and References

  1. SO Discusion: List of in-built datasets in R

***

Sales revenue app - Shiny dashboard

Reference link

replicating the code

  • Note taken on [2019-02-06 Wed 10:17]

Loading libraries

library("easypackages")
libraries("shiny", "shinydashboard", "tidyverse")

Downloading raw csv and loading into variable

## Download file to specific location
system("wget \"https://raw.githubusercontent.com/amrrs/sample_revenue_dashboard_shiny/master/recommendation.csv\" -P ./sales-rev-app/")

Reading in the csv file

recommendation_raw  <- read.csv("./sales-rev-app/recommendation.csv", stringsAsFactors = FALSE, header = TRUE)

Init dashboard

## Defining individual components

## header
header <- dashboardHeader(title = "Sales Revenue Dashboard")

## sidebar contents
sidebar <-
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard",
               icon = icon("dashboard"),
               tabName = "dashboard"
               ),
      menuItem("Visit us",
               icon = icon("send", lib = 'glyphicon'),
               href = "https://shrysr.github.io"
               )
    )
  )

## Defining individual rows
frow1 <- fluidRow(
  box(
    valueBoxOutput("value1"),
    valueBoxOutput("value2"),
    valueBoxOutput("value3")

  )
)

frow2 <- fluidRow(
  box(
    title = "Revenue per account",
    status = "primary",
    solidHeader = TRUE,
    collapsible = TRUE,
    plotOutput("revenuebyacct", height = "300px")
  )
)

## combining the defined fluid rows into the dashboard body
body <- dashboardBody(frow1, frow2)

## Defining UI
ui <- dashboardPage(title = "test title", header,sidebar, body)
## Define server logic

server <- function(input, output){
  ## Data manipulation
  total_revenue <- sum(recommendation_raw$revenue)
  sales_account <-
    recommendation_raw %>%
    group_by(Account) %>%
    summarise(value = sum(Revenue)) %>%
    filter(value == max(value))

  prof_prod <-
    recommendation_raw %>%
    group_by(Product) %>%
    summarise(value = sum(Revenue)) %>%
    filter(value == max(value))

  ## Creating valuebox output
  output$value1 <- renderValueBox ({
    valueBox(
      formatC(sales_account$value, format = "d", big.mark= ','),
      paste('Top Account: ', sales_account$Account),
      icon = icon("stats", lib ='glyphicon'),
      color = "purple"
    )
  })

  output$value2 <- renderValueBox({
    valueBox(
      formatC(total_revenue, format = "d", big.mark = ','),
      paste('Top Account: ', sales_account$Account),
      icon = icon("gbp", lib = 'glyphicon'),
      color = "green"
    )
  })

  output$value3 <- renderValueBox({
    valueBox(
      formatC(total_revenue, format = "d", big.mark = ','),
      paste("Top Product: ", prof_prod$Product),
      icon = icon("menu-hamburger", lib = 'glyphicon'),
      color = "yellow"
    )
  })

}
## Run the app
shinyApp(ui = ui, server = server)

App Recreation

These apps have been re-built mostly as is to gain familiarity, and with some minor explorations from official tutorials.

Shiny Tutorials - Rstudio [5/6]

Re-implementing Rstudio’s tutorials with minor tweaks and additional explorations in some areas. *

Lesson 1

App description and Readme

Title: Hello Shiny! - Lesson 1 of Rstudio tutorials
Author: Shreyas
AuthorUrl: https://shreyas.ragavan.co
License: MIT
DisplayMode: Showcase
Tags: getting-started
Type: Shiny
This app is a reproduction of lesson 1 of the official Rstudio tutorials. Change the slider to modify the number of bins.

Installing the shiny library

install.packages("shiny")

Running in-built shiny examples

runExample("01_hello")
library(shiny)

# Define UI for app that draws a histogram ----
ui <- fluidPage(

  # App title ----
  titlePanel("Hello Shiny!"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Slider for the number of bins ----
      sliderInput(inputId = "bins",
                  label = "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)

    ),

    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Histogram ----
      plotOutput(outputId = "distPlot")

    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output) {

  # Histogram of the Old Faithful Geyser Data ----
  # with requested number of bins
  # This expression that generates a histogram is wrapped in a call
  # to renderPlot to indicate that:
  #
  # 1. It is "reactive" and therefore should be automatically
  #    re-executed when inputs (input$bins) change
  # 2. Its output type is a plot

  output$distPlot <- renderPlot({

    x    <- faithful$waiting
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = "Waiting time to next eruption (in mins)",
         main = "Histogram of waiting times")

    })

}

# Create Shiny app ----
shinyApp(ui = ui, server = server)

Lesson 2 Jumbotron

App description and Readme

Title: Hello Shiny! - Lesson 2 of Rstudio tutorials
Author: Shreyas
AuthorUrl: https://shreyas.ragavan.co
License: MIT
DisplayMode: Showcase
Tags: getting-started
Type: Shiny
This app is a reproduction of lesson 2 of the official Rstudio tutorials. This is a simple display of a jumbotron.

Starting with custom app

library(shiny)

## Define UI
ui  <- fluidPage(

    titlePanel("This is the title"),

    sidebarLayout(
        sidebarPanel("Hello panel",
                     h2("This is h2 title in the sidepanel")),
        mainPanel("main panel",
                  h1("Another title in h1", align = "center")
                  ),
#        position = "right"
    )

)
## Define server logic

server <- function(input, output){


}



## Run the app
shinyApp(ui = ui, server = server)

Test app for formatting difference highlight

library(shiny)

ui <- fluidPage(
  titlePanel("My Shiny App"),
  sidebarLayout(
    sidebarPanel(),
    mainPanel(
      p("p creates a paragraph of text."),
      p("A new p() command starts a new paragraph. Supply a style attribute to change the format of the entire paragraph.", style = "font-family: 'times'; font-si16pt"),
      strong("strong() makes bold text."),
      em("em() creates italicized (i.e, emphasized) text."),
      br(),
      code("code displays your text similar to computer code"),
      div("div creates segments of text with a similar style. This division of text is all blue because I passed the argument 'style = color:blue' to div", style = "color:blue"),
      br(),
      p("span does the same thing as div, but it works with",
        span("groups of words", style = "color:blue"),
        "that appear inside a paragraph.")
    )
  )
)


## Run the app
shinyApp(ui = ui, server = server)

Testing knowledge. See app-02

library(shiny)

## Define UI
ui  <- fluidPage(
    titlePanel("My Shiny App"),

    sidebarLayout(
        sidebarPanel(h1("Installation"),
                     p("Shiny is available on CRAN, so you can install it the usual way using:"),
                     br(),
                     code('install.packages("shiny")'),
                     img(src="rstudio.png", height = 70, width = 200),
                     p("Shiny is a product of ", a("Rstudio",
                                                 href="http://www.shiny.rstudio.com"))
                     ),
        mainPanel()
    )
)


## Define server logic
server <- function(input, output){}



## Run the app
shinyApp(ui = ui, server = server)

Lesson 3 Multiple columns

App description and readme

Title: Hello Shiny! - Lesson 3 of Rstudio tutorials
Author: Shreyas
AuthorUrl: https://shreyas.ragavan.co
License: MIT
DisplayMode: Showcase
Tags: getting-started
Type: Shiny
This app is a reproduction of lesson 3 of the official Rstudio tutorials. This is a display of several widgets available with Shiny spread over multiple columns.

Re-implementing example. See app-03

library(shiny)

## Define UI
ui  <- fluidPage(
  titlePanel("Basic widget exploration"),

  fluidRow(

    column(2,
           h3("buttons"),
           actionButton("action007", label ="Action"),
           br(),
           br(),
           submitButton("Submit")
           ),
    column(2,
           h3("Single Checkbox"),
           checkboxInput("checkbox", "Choice A", value = T)
           ),
    column(3,
           checkboxGroupInput("checkGroup",
                              h3("checkbox group"),
                              choices = list("Choice 1" = 1,
                                             "Choice 2" = 2,
                                             "Choice 3" = 3
                                             ),
                              selected = 1
                              )
           ),
    column(2,
           dateInput("date",
                     h3("date input"),
                     value = ""
                     )
           )

  ),
  ## Inserting another fluid row element
  fluidRow(

    column(2,
           radioButtons("radio",
                        h3("Radio Buttons"),
                        choices = list("choice 1" = 1,
                                       "choice 2" = 2,
                                       "Radio 3"  = 3
                                       ),
                        selected =1
                        )
           ),

    column(2,
           selectInput("select",
                       h3("Select box"),
                       choices = list("choice 1" = 1,
                                      "choice 2" = 2,
                                      "choice 3" = 3
                                      ),
                       selected = 1
                       )
           ),
    column(2,
           sliderInput("slider1",
                       h3("Sliders"),
                       min = 0,
                       max = 100,
                       value = 50
                       ),

           sliderInput("slider2",
                       h3("Another Slider"),
                       min = 50,
                       max = 200,
                       value = c(60,80)
                       )
           ),
    column(2,
           selectInput("selectbox1",
                     h3("select from drop down box"),
                     choices = list("choice 1" = 22,
                                    "choice 2" = 2,
                                    "choice fake 3" = 33
                                    ),
                     selected = ""
                     )
           )

  ),
  fluidRow(
    column(3,
           dateRangeInput("daterange",
                          h3("Date range input")
                          )
           ),

    column(3,
           fileInput("fileinput",
                     h3("Select File")
                     )
           ),

    column(3,
           numericInput("numinput",
                        h3("Enter numeric value"),
                        value = 10
                        )
           ),
    column(3,
           h3("help text"),
           helpText("Hello this is line one.",
                    "This is line 2..\n",
                    "This is line 3."
                    )
           )
  )
)


## Define server logic

server <- function(input, output){


}



## Run the app
shinyApp(ui = ui, server = server)

Lesson 4 : reactive ouput display, census viz

Reactive censusViz task. See census-app

library("easypackages")
libraries("shiny", "dplyr", "stringr")

## Define UI
ui  <- fluidPage(
  titlePanel("censusViz"),

  sidebarLayout(
    sidebarPanel(
      helpText("Create demographic maps with information form the 2010 US Census"),
      selectInput("inputbox1",
                  h2("Choose variable to display:"),
                  choices = list("Percent White" ,
                                 "Percent Black",
                                 "Percent Hispanic",
                                 "Percent Asian"
                                ),
                  selected = ""
                  ),
      sliderInput("slider1",
                  h2("Range of interest:"),
                  min = 0,
                  max = 100,
                  value = c(0,100)
                  )
    ),
    mainPanel(h1("Reactive Output"),
              textOutput("selected_var"),
              textOutput("slider_range")
              )
  )
)


## Define server logic

server <- function(input, output){

  output$selected_var <- renderText({
    str_glue("Selected option is {input$inputbox1} ")
  })

  output$slider_range <- renderText({
    str_glue("Range selected from \n {input$slider1[1]} to {input$slider1[2]}")
  })
}



## Run the app
shinyApp(ui = ui, server = server)

Test: passing a list to the input choices

  • Note taken on [2019-02-05 Tue 11:04]
    Testing to see if a list defined in a variable can be passed as choices. This is possible.
library("easypackages")
libraries("shiny", "dplyr", "stringr")

## List to pass into the input box choices
test_list = list("Percent White" ,
                 "Percent Black",
                 "Percent Hispanic",
                 "Percent Asian"
                 )
## Define UI
ui  <- fluidPage(
  titlePanel("censusViz"),

  sidebarLayout(
    sidebarPanel(
      helpText("Create demographic maps with information form the 2010 US Census"),
      selectInput("inputbox1",
                  h2("Choose variable to display:"),
                  choices = test_list,
                  selected = ""
                  ),
      sliderInput("slider1",
                  h2("Range of interest:"),
                  min = 0,
                  max = 100,
                  value = c(0,100)
                  )
    ),
    mainPanel(h1("Reactive Output"),
              textOutput("selected_var"),
              textOutput("slider_range")
              )
  )
)


## Define server logic

server <- function(input, output){

  output$selected_var <- renderText({
    str_glue("Selected option is {input$inputbox1} ")
  })

  output$slider_range <- renderText({
    str_glue("Range selected from \n {input$slider1[1]} to {input$slider1[2]}")
  })
}



## Run the app
shinyApp(ui = ui, server = server)

Lesson 5: more complex reactive output

Testing the helpers.R script for a chloropleth map

library(easypackages)
packages("maps", "mapproj")
source("./census-app-02/01_scripts/helpers.R")
counties  <- read_rds("./census-app-02/00_data/counties.rds")
percent_map(counties$white, "darkgreen", "% White")

Setting up chloropleth output in shiny app

Using the dataset counties.rds collected with the Uscensus2010 R package. Download link.
library("easypackages")
libraries("shiny", "dplyr", "stringr", "readr", "maps", "mapproj")


## Reading the counties dataset and glimpsing
source("helpers.R")
counties <- read_rds("./00_data/counties.rds")
counties %>% glimpse()

## Define UI
ui  <- fluidPage(
  titlePanel("censusViz"),

  sidebarLayout(
    sidebarPanel(
      helpText("Create demographic maps with information form the 2010 US Census"),
      selectInput("inputbox1",
                  h2("Choose variable to display:"),
                  choices = list("Percent White" ,
                                 "Percent Black",
                                 "Percent Hispanic",
                                 "Percent Asian"
                                ),
                  selected = ""
                  ),
      sliderInput("slider1",
                  h2("Range of interest:"),
                  min = 0,
                  max = 100,
                  value = c(0,100)
                  )
    ),
    mainPanel(h1("Reactive Output"),
              textOutput("selected_var"),
              textOutput("slider_range"),
              plotOutput("map")
              )
  )
)

## Define server logic
server <- function(input, output){

  output$selected_var <- renderText({
    str_glue("Selected option is {input$inputbox1} ")
  })

  output$slider_range <- renderText({
    str_glue("Range selected from \n {input$slider1[1]} to {input$slider1[2]}")
  })

  output$map  <- renderPlot({

    arg_list  <-  switch(input$inputbox1,
                         "Percent White" = list(counties$white, "darkgreen","% White population"),
                         "Percent Black" = list(counties$black, "black","% Black population"),
                         "Percent Asian" = list(counties$asian, "darkorange","% Asian population"),
                         "Percent Hispanic" = list(counties$hispanic, "pink","% Hispanic population"),
                         )

    arg_list$max = input$slider1[2]
    arg_list$min = input$slider1[1]

    do.call(percent_map,arg_list)

  })
}



## Run the app
shinyApp(ui = ui, server = server)

Lesson 6: stockVis app

Recreating in-built Shiny examples [2/3]

Eg 1 Hello Shiny. See hello-shiny

library(shiny)

## Define UI
ui  <- fluidPage(
  titlePanel("Hello Shiny"),

  sidebarLayout(
    sidebarPanel(
      sliderInput("slider1",
                  label = "Number of Bins",
                  min = 1,
                  max = 50,
                  value = 20
                  )
    ),
      mainPanel("",
                plotOutput("histplot")
                )
  )
)


## Define server logic

server <- function(input, output){

  output$histplot <- renderPlot({

    dataset <- faithful$waiting
    bins <- seq(min(dataset), max(dataset), length.out = input$slider1 +1)

    hist(dataset, breaks = bins, col = "blue", border = "white",
         xlab = "Waiting time to next eruption(mins)",
         main = "Histogram of waiting times"
         )
  })

}

## Run the app
shinyApp(ui = ui, server = server)

Eg 2 Shiny text. See shiny-text-eg2

library(shiny)
library(tidyverse)

## Define UI
ui  <- fluidPage(
  titlePanel("Shiny text"),

  sidebarLayout(
    sidebarPanel(
      selectInput("dataset_choice",
                  label = "Choose a dataset",
                  choices = c("rock", "diamonds", "cars"),
                  #value = ""
                  ),
      numericInput("observation_number",
                   label = "Choose number of observations to display",
                   value = 10
                   )
    ),
    mainPanel(

      verbatimTextOutput("summary"),

      tableOutput("view")
    )
  )
)


## Define server logic

server <- function(input, output){

  datasetInput <- reactive({
    switch(input$dataset_choice,
           "rock" = rock,
           "diamonds"  = diamonds,
           "cars"   = cars
           )
  })

  output$summary <- renderPrint({
    datasetInput() %>% summary()
  })

  output$view <- renderTable({
    datasetInput() %>% head(n = input$observation_number)
  })
}



## Run the app
shinyApp(ui = ui, server = server)

Eg 6 - tabsets. See tabsets-eg-6

library(shiny)
library(shinythemes)

## Define UI
ui  <- fluidPage(
  themeSelector(),
  titlePanel("Using tabsets"),

  sidebarLayout(
    sidebarPanel(
      radioButtons("dist_type",
                   "Distribution type",
                   choices = c("Normal" = "norm",
                               "Uniform" = "unif",
                               "Log-normal" = "lnorm",
                               "Exponential" = "exp"
                               )
                   ),
      sliderInput("slider1",
                  label = "Number of observations",
                  min = 1,
                  max = 1000,
                  value = 500
                  )
    ),

    mainPanel(

      tabsetPanel(type = "tabs",
                  tabPanel(title = "Plot", plotOutput("plot1")),
                  tabPanel(title = "Summary", verbatimTextOutput("vbto1_summary")),
                  tabPanel(title = "Table", tableOutput("tabl1"))
                  )
    )
  )
)


## Define server logic

server <- function(input, output){
  d <- reactive({
    dist <- switch(input$dist_type,
           norm = rnorm,
           unif = runif,
           lnorm = rlnorm,
           exp = exp
#           rnorm
           )

    dist(input$slider1)
  })

  output$plot1 <- renderPlot({
    dist <- input$dist_type
    n <- input$slider1

    hist(d(),
         main = paste("r", dist, "(", n, ")", sep = ""),
         col = "blue", border = "white")
  })

  output$vbto1_summary <- renderText({
    summary(d())
  })

  output$tabl1 <- renderTable({
    d()
  })
}

## Run the app
shinyApp(ui = ui, server = server)

Shiny Dashboard init

References and notes

  1. Rstudio documentation, getting started with Shiny Dashboard link
  2. There are 2 types of packages available to create dashboards flexdashboard and shiny dashboard.

Installing shiny dashboard

install.packages("shinydashboard")

Basic app – Init. See dashboard-01

library("easypackages")
libraries("shiny","shinydashboard", "tidyverse")

## Define UI
ui  <- dashboardPage(
  ## Inserting the 3 components: header, sidebar, body

  dashboardHeader(title = "Basic Dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard",
               tabName = "dashboard",
               icon = icon("dashboard")),
      menuItem("Widgets",
               tabName = "widgets",
               icon = icon("th")
               )
    )
  ),
  dashboardBody(
    ## Adding a fluidRow with boxes for plot and slider input
    tabItems(
      tabItem(
        tabName = "dashboard",
        fluidRow(

          box(plotOutput(
            "plot1",
            height = 250
          )),

          box(
            title = "Controls",
            sliderInput("slider1",
                        "Number of observations",
                        min = 1,
                        max = 100,
                        value = 50)
          )
        )
      ),

      tabItem(tabName = "widgets",
              h2("Widgets tab")
              )
    )
  )
)

## Define server logic

server <- function(input, output){
  set.seed(120)
  histdata <- rnorm(1000)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider1)]
    hist(data)
  })

}

## Run the app
shinyApp(ui = ui, server = server)

Notes on the structure of a dashboard: Rstudio documentation link

Main components : header, sidebar, body -> defined for dashboardPage()

These can be split up into separate variables and fed into the dashboardPage function. This is useful in the case of complex or long programs.

header  <- dashboardHeader()  # Defining the content of each function into a variable
sidebar  <- dashboardSiderbar()
body  <- dashboardBody()

dashboardPage(header, sidebar, body)
Header

This will contain the dropdownMenu() items of different types. The types could could be messages or notifications etc.

Experimenting with structures

Incorporating elements from the structures overview in Rstudio’s documentation (link).

Dropdown menu items (static) : messages, tasks, notifications

library("easypackages")
libraries("shiny","shinydashboard", "tidyverse")

## Define UI
ui  <- dashboardPage(
  ## Inserting the 3 components: header, sidebar, body

  dashboardHeader(title = "Basic Dashboard",
                  ##Experimenting with static dropdown menu message items.
                  dropdownMenu(
                    type = "messages",
                    ## Message items require a 'from' and 'message' argument
                    messageItem(
                      from = "Sales Dept",
                      message = "Sales are steady."
                    ),
                    messageItem(
                      from = "Shop Floor",
                      message = "Job XXX is done"
                    )
                  ),
                  ## Adding static tasks items in dropdown menu
                  dropdownMenu(type = "tasks",
                               taskItem(value = 37,
                                        ## The value denotes the percentage completion
                                        color = "red",
                                        "Test Project 1"
                                        ),
                               taskItem(value = 50,
                                        color = "blue",
                                        "Test Project 2"
                                        )
                               ),

                  dropdownMenu(type = "notifications",
                               notificationItem(
                                 text = "Blah Blah Today is cold",
                                 icon("users")
                               ),
                               notificationItem(
                                 text = "Another notification",
                                 icon("truck"),
                                 status = "success"
                               ),
                               notificationItem(
                                 text = "3rd notification",
                                 icon("exclamation-triangle"),
                                 status = "warning"
                               )
                               )
                  ),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard",
               tabName = "dashboard",
               icon = icon("dashboard")),
      menuItem("Widgets",
               tabName = "widgets",
               icon = icon("th")
               )
    )
  ),
  dashboardBody(
    ## Adding a fluidRow with boxes for plot and slider input
    ## Assigning the tab to the tab names and populating individual content
    tabItems(
      tabItem(
        tabName = "dashboard",
        fluidRow(
          ## Note that the objects are encapsulated within a box
          box(plotOutput(
            "plot1",
            height = 250
          )),

          box(
            title = "Controls",
            sliderInput("slider1",
                        "Number of observations",
                        min = 1,
                        max = 100,
                        value = 50)
          )
        )
      ),

      tabItem(tabName = "widgets",
              h2("Widgets tab")
              )
    )
  )
)

## Define server logic

server <- function(input, output){
  set.seed(120)
  histdata <- rnorm(1000)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider1)]
    hist(data)
  })

}

## Run the app
shinyApp(ui = ui, server = server)

Dropdown menu for messages with Dynamic message items

About

Shiny apps and exploration in using Shiny to build dashboards for data analysis and machine learning.

Topics

Resources

Stars

Watchers

Forks

Releases

No releases published

Packages

No packages published

Languages