Untitled Document

1.: Create a dashboard to show the current conditions and temperature in both Fahrenheit and Celsius at a city. Your will need the rwunderground package and an API key.

library(shiny)
library(shinydashboard)
library(rwunderground)
library(measurements)

set_api_key("API key")

header <- dashboardHeader(title = 'Athens GA weather watch')
sidebar <- dashboardSidebar()

loc <-  set_location(airport_code = 'AHN')
weather <-  conditions(loc)
weather$tempC <- round(conv_unit(weather$temp,'F','C'),1) 
boxTemperatureF <-  box(title='Fahrenheit', weather$temp)
boxTemperatureC <-  box(title='Celsius',weather$tempC)
row1 <-  fluidRow(boxTemperatureF, boxTemperatureC)
body <- dashboardBody(row1)
ui <- dashboardPage(header,sidebar,body)

server <- function(input, output) {}

shinyApp(ui, server)

2.: Revise the dashboard created in the prior exercise to allow someone to select from up to five cities to get the weather details for that city.

library(shiny)
library(shinydashboard)
library(measurements)

header <- dashboardHeader(title =  'Current weather')
sidebar <- dashboardSidebar()
boxCity <-  box(selectInput('code', 'City:', choices = c('Atlanta' = 'ATL', 'Fairbanks' = 'FAI', 'New York' = 'JFK', 'Phoenix' = 'PHX', 'San Francisco' = 'SFO'), selected = 'ATL'))
valueBoxC <-  valueBox(textOutput('C'), width=3, subtitle = 'C', color= ('yellow'))
valueBoxF <-  valueBox(textOutput('F'), width=3, subtitle = 'F', color= ('yellow'))
row1 <-  fluidRow(boxCity)
row2 <-  fluidRow(valueBoxF, valueBoxC)
body <- dashboardBody(row1,row2)
ui <- dashboardPage(header,sidebar,body)

server <- function(input, output) {
output$text <- renderText({paste(input$City, ' weather watch')})
output$F <-  renderText({conditions(set_location(airport_code = input$code))$temp})
output$C <-  renderText({round(conv_unit(conditions(set_location(airport_code = input$code))$temp,"F","C"),1)})

}

shinyApp(ui, server)

3.: Extend the previous dashboard. If the temperature is about 30C (86F), code the server function to give both temperature boxes a red background and if it is below 10C (50F) give both a blue background. Otherwise the color should be yellow.

library(shiny)
library(shinydashboard)
library(rwunderground)

header <- dashboardHeader(title =  'Current weather')
sidebar <- dashboardSidebar()
boxCity <-  box(selectInput('code', 'City:', choices = c('Atlanta' = 'ATL', 'Fairbanks' = 'FAI', 'New York' = 'JFK', 'Phoenix' = 'PHX', 'San Francisco' = 'SFO'), selected = 'ATL'))
#boxCondition <-  box(title = 'Current conditions: ', textOutput('condition'), background = 'blue')ndition <-
boxTime <-  box(textOutput('time'))
row1 <-  fluidRow(boxCity)
row2 <-  fluidRow(valueBoxOutput("vboxF"), valueBoxOutput("vboxC"))
body <- dashboardBody(row1,row2)

ui <- dashboardPage(header,sidebar,body)

server <- function(input, output) {
  output$vboxF <- renderValueBox({
    t <-
      as.numeric(conditions(set_location(airport_code = input$code))$temp)
    if (t  > 86)
    {
      valueBox(t, width = 3, subtitle = 'F', color = 'red')
    }
    else if (t < 50)
    {
      valueBox(t, width = 3, subtitle = 'F', color = 'blue')
    }
    else {
      valueBox(t, width = 3, subtitle = 'F', color = 'yellow')
    }
  })
  output$vboxC <- renderValueBox({
    t <-
      as.numeric(  output$vboxC <- renderValueBox({
        t <-
          as.numeric(round(conv_unit(conditions(set_location(airport_code = input$code))$temp,"F","C"),1))
        if (t  > 30)
        {
          valueBox(t, width = 3, subtitle = 'C', color = 'red')
        }
        else if (t < 10)
        {
          valueBox(t, width = 3, subtitle = 'C', color = 'blue')
        }
        else {
          valueBox(t, width = 3, subtitle = 'C', color = 'yellow')
        }
      })
      )
    if (t  > 30)
    {
      valueBox(t, width = 3, subtitle = 'C', color = 'red')
    }
    else if (t < 10)
    {
      valueBox(t, width = 3, subtitle = 'C', color = 'blue')
    }
    else {
      valueBox(t, width = 3, subtitle = 'C', color = 'yellow')
    }
  })
  
}

shinyApp(ui, server)

4.: Use the WDI package to access World Bank Data and create a dashboard for a country of your choosing. Show three or more of the most current measures of the state of the selected country as an information box.

library(ggplot2)
library(WDI)
library(WDI)
library(ggplot2)
library(countrycode)
# Use the WDIsearch function to get a list of GDP indicators
indicatorMetaData <- WDIsearch("gdp")
# Pull out indicator names
indicatorNames <- indicatorMetaData[1:10,2]
# Define a list of countries for which to pull data
countries <- c("Australia")
# Convert the country names to iso2c format used in the World Bank data
iso2cNames <- countrycode(countries, "country.name", "iso2c")
# Pull data for the first three indicators for 2011
wdiData <- WDI(iso2cNames, indicatorMetaData[1:3,1], start=2011, end=2011)

header <- dashboardHeader(title = 'Australian GDP 2011')
sidebar <- dashboardSidebar()
infoGDP1 <- infoBox(title = indicatorNames[1],  round(wdiData[1,4],2),width = 8)
infoGDP2 <- infoBox(title = indicatorNames[2],  round(wdiData[1,5],2),width = 8)
infoGDP3 <- infoBox(title = indicatorNames[3],  round(wdiData[1,6],2),width = 8)
row1 <-  fluidRow(infoGDP1)
row2 <-  fluidRow(infoGDP2)
row3 <-  fluidRow(infoGDP3)
body <- dashboardBody(row1,row2,row3)
ui <- dashboardPage(header,sidebar,body)
server <- function(input, output) {}
shinyApp(ui, server)

5.: Use the WDI package to access World Bank Data for China, India, and the US for three variables, (1) CO₂ emissions (metric tons per capita), (2) Electric power consumption (kWh per capita), and (3) forest area (% of land area). The corresponding WDI codes are: EN.ATM.CO2E.PC, EG.USE.ELEC.KH.PC, and AG.LND.FRST.ZS. Set up a dashboard so that a person can select the country from a pull down list and then the data for that country are shown in three infoboxes.

library(WDI)
library(ggplot2)
library(countrycode)
library(shinydashboard)

header <- dashboardHeader(title = 'Environmental data')
side <-
  sidebarMenu(menuItem(
    "Reporting options", tabName = "dashboard", icon = icon("dashboard")
  ))
pullType <-
  selectInput(
    'countryCode', 'Country:', choices = c('China' = 'CN', 'India' = 'IN', 'United States' = 'US'))
sidebar <-
  dashboardSidebar(sidebarMenu(side),pullType)
w <-  8
info1 <- infoBox(title = textOutput('title1'),  textOutput("wdiData1"), width = w, icon = icon("fire", lib = "glyphicon"), color='red')
info2 <- infoBox(title = textOutput('title2'),  textOutput("wdiData2"), width = w, icon = icon("tree-conifer", lib = "glyphicon"), color='green')
info3 <- infoBox(title = textOutput('title3'),  textOutput("wdiData3"), width = w, icon = icon("cloud", lib = "glyphicon"), color='orange')
row1 <-  fluidRow(info1)
row2 <-  fluidRow(info2)
row3 <-  fluidRow(info3)
body <- dashboardBody(row1,row2,row3)
ui <- dashboardPage(header,sidebar,body)
server <- function(input, output) {
output$wdiData1 <- renderText({
  WDI(input$countryCode, indicator=c('EG.USE.ELEC.KH.PC'),start=2011, end=2011)[1,3]
 })
output$title1 <- renderText({
  WDIsearch(string='EG.USE.ELEC.KH.PC',field='indicator')[2]
})
output$wdiData2 <- renderText({
  WDI(input$countryCode, indicator=c( 'AG.LND.FRST.ZS'),start=2011, end=2011)[1,3]
})
output$title2 <- renderText({
  WDIsearch(string='AG.LND.FRST.ZS',field='indicator')[2]
})
output$wdiData3 <- renderText({ 
  WDI(input$countryCode, indicator=c('EN.ATM.CO2E.PC'),start=2011, end=2011)[1,3]
 })
output$title3 <- renderText({
  WDIsearch(string='EN.ATM.CO2E.PC',field='indicator')[2]
})
}
shinyApp(ui, server)

6.: Use the WDI package to access World Bank Data for China, India, and the US for three variables, (1) CO₂ emissions (metric tons per capita), (2) Electric power consumption (kWh per capita), and (3) forest area (% of land area). The corresponding WDI codes are: EN.ATM.CO2E.PC, EG.USE.ELEC.KH.PC, and AG.LND.FRST.ZS. Set up a dashboard so that a person can select one of the three measures, and then the data for each country are shown in separate infoboxes.

library(WDI)
library(countrycode)
library(shinydashboard)
library

header <- dashboardHeader(title = 'Environmental data')
side <-
  sidebarMenu(menuItem(
    "Reporting options", tabName = "dashboard", icon = icon("dashboard")
  ))

pullType <-
  selectInput(
    'measure', 'Measure:', choices = c('Electricity consumption in kWh per capita)' = 'EG.USE.ELEC.KH.PC', 
                                           'Forest area as % of land area' = 'AG.LND.FRST.ZS', 
                                           'CO2 emissions in metric tons per capita' = 'EN.ATM.CO2E.PC'))
sidebar <-
  dashboardSidebar(sidebarMenu(side),pullType)
w <-  4
info1 <- infoBox(title = 'China',  textOutput("wdiData1"), width = w,  color='red', icon = icon("flag", lib = "glyphicon"))
info2 <- infoBox(title = 'India',  textOutput("wdiData2"), width = w, color = 'orange', icon = icon("flag", lib = "glyphicon"))
info3 <- infoBox(title = 'USA',  textOutput("wdiData3"), width = w, color = 'blue', icon = icon("flag", lib = "glyphicon"))
row1 <-  fluidRow(info1)
row2 <-  fluidRow(info2)
row3 <-  fluidRow(info3)
body <- dashboardBody(row1,row2,row3)
ui <- dashboardPage(header,sidebar,body)

server <- function(input, output) {
output$wdiData1 <- renderText({
  round(WDI('CN', indicator=input$measure,start=2011, end=2011)[1,3],2)
 })
output$wdiData2 <- renderText({
  round(WDI('IN', indicator=input$measure,start=2011, end=2011)[1,3],2)
})
output$wdiData3 <- renderText({ 
  round(WDI('US', indicator=input$measure,start=2011, end=2011)[1,3],2)
 })
}
shinyApp(ui, server)

7.

Create a dashboard to:

Show the conversion rate between two currencies using the quantmod package to retrieve exchange rates. Let a person select from one of five currencies using a drop down box;
Show the value of input amount when converted one of the selected currencies to the other selected currency;
Show the exchange rate between the two selected currencies over the last 100 days.

library(quantmod)
library(shinydashboard)
library(dygraphs)
library(shiny)
header <- dashboardHeader(title = 'Currency convertor')
side <-
  sidebarMenu(menuItem(
    "Currencies", tabName = "dashboard", icon = icon("calculator")
  ))

pullCurr1 <-
  selectInput(
    'currency1', 'From:', choices = c('Australian dollar' = 'AUD', 'Chinese Yuan' = 'CNY', 'Euro' = 'EUR', 'Japanese Yen' = 'JPY', 'US dollar' = 'USD'))
pullCurr2 <-
  selectInput(
    'currency2', 'To:', choices = c('Australian dollar' = 'AUD', 'Chinese Yuan' = 'CNY', 'Euro' = 'EUR', 'Japanese Yen' = 'JPY', 'US dollar' = 'USD'))
amt <-  numericInput('amt', label = "Amount", 100)
sidebar <-
  dashboardSidebar(sidebarMenu(side),pullCurr1, pullCurr2, amt)
info1 <- infoBox(title = textOutput('Conversion'),  textOutput("rate"), icon = icon("exchange"), color='red')
info2 <- valueBox(textOutput('Amount'),  h3(textOutput("amt")), color='yellow')
row2 <- fluidRow(box(title='Market last 100 days', width=12, dygraphOutput("exchange")))

row1 <-  fluidRow(info1,info2)
body <- dashboardBody(row1,row2)
ui <- dashboardPage(header,sidebar,body)

server <- function(input, output){
  
  output$rate <-  renderText({
    swap <-  paste0(input$currency1,'/',input$currency2)
    get(getFX(swap,from=Sys.Date()))})
output$amt <-  renderText({
  swap <-  paste0(input$currency1,'/',input$currency2)
  get(getFX(swap,from=Sys.Date()))*input$amt
  })
output$exchange <- renderDygraph({
  swap <-  paste0(input$currency1,'/',input$currency2)
  dygraph(get(getFX(swap,from=Sys.Date()-100,to=Sys.Date())))
      })
}

shinyApp(ui, server)

19 - Dashboards

Answers to exercises

Date revised: 10-Dec-2021