ANLY 512 - Lab 1

Dashboard Design

Dashboard

A caption

Data Preparation

library(quantmod)

## Loading required package: xts

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## Loading required package: TTR

## Version 0.4-0 included new data defaults. See ?getSymbols.

library(ggplot2)
library(plyr)
library(pdfetch)
library(Quandl)
library(shiny)
library(shinydashboard)

## 
## Attaching package: 'shinydashboard'

## The following object is masked from 'package:graphics':
## 
##     box

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:plyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize

## The following objects are masked from 'package:xts':
## 
##     first, last

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

what_metrics <- yahooQF(c("Price/Sales", 
                          "P/E Ratio",
                          "Price/EPS Estimate Next Year",
                          "PEG Ratio",
                          "Dividend Yield", 
                          "Market Capitalization"))

tickers <- c("HPQ", "GS", "ORCL", "SAP")
# Not all the metrics are returned by Yahoo.
metrics <- getQuote(paste(tickers, sep="", collapse=";"), what=what_metrics)

#Add tickers as the first column and remove the first column which had date stamps
metrics <- data.frame(Symbol=tickers, metrics[,2:length(metrics)]) 

#Change colnames
colnames(metrics) <- c("Symbol", "PE", "EPS", "Dividend", "MarketCap")

Build UI / Server structure

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody()
)
server <- function(input, output) { }


#Dashboard header carrying the title of the dashboard
header <- dashboardHeader(title = "ANLY 512 Lab 1")
#Sidebar content of the dashboard
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Visit-us", icon = icon("send",lib='glyphicon'), 
             href = "https://www.salesforce.com"),
    menuItem("Designed by: Yiwen Zhao")
  )
)

Set up charts structure

frow1 <- fluidRow(
  valueBoxOutput("value1")
  ,valueBoxOutput("value2")
  ,valueBoxOutput("value3")
)
frow2 <- fluidRow( 
  box(
    title = "PE Ratio by Company" 
    ,status = "primary"
    ,solidHeader = TRUE 
    ,collapsible = TRUE 
    ,plotOutput("PEbycompany", height = "300px")
  )
  ,box(
    title = "EPS by Company"
    ,status = "primary"
    ,solidHeader = TRUE 
    ,collapsible = TRUE 
    ,plotOutput("EPSbycompany", height = "300px")
  ) 
)

# combine the two fluid rows to make the body
body <- dashboardBody(frow1, frow2)

#completing the ui part with dashboardPage
ui <- dashboardPage(title = 'Company Comparison by KPI', header, sidebar, body, skin='red')

Create the Server functions

# create the server functions for the dashboard  
server <- function(input, output) { 
  #some data manipulation to derive the values of KPI boxes

  max.pe = metrics %>% group_by(Symbol) %>% summarise(value = sum(PE)) %>% filter(value==max(value))
  max.eps= metrics %>% group_by(Symbol) %>% summarise(value = sum(EPS)) %>% filter(value==max(value))
  max.div= metrics %>% group_by(Symbol) %>% summarise(value = sum(Dividend)) %>% filter(value==max(value))
   
#creating the valueBoxOutput content
  output$value1 <- renderValueBox({
    valueBox(
      formatC(max.pe$value, digits=2, format="f", big.mark=',')
      ,paste('Top PE:', max.pe$Symbol)
      ,icon = icon("stats",lib='glyphicon')
      ,color = "purple")  
  })
  output$value2 <- renderValueBox({ 
    valueBox(
      formatC(max.eps$value, digits=2, format="f", big.mark=',')
      ,paste('Top EPS:', max.eps$Symbol)
      ,icon = icon("menu-hamburger",lib='glyphicon')
      ,color = "green")  
  })
output$value3 <- renderValueBox({
    valueBox(
      formatC(max.div$value, digits=2,  format="f", big.mark=',')
      ,paste('Top Dividend:', max.div$Symbol)
      ,icon = icon("usd",lib='glyphicon')
      ,color = "yellow")   
  })
#creating the plotOutput content
  output$PEbycompany <- renderPlot({
    ggplot(data = metrics, 
           aes(x=Symbol, y=PE, fill=Symbol))+
      geom_bar(position = "dodge", stat = "identity") + ylab("P-E Value") + 
      xlab("Company") + theme(legend.position="right" 
                              ,plot.title = element_text(size=15, face="bold")) + 
      ggtitle("P-E Ratio by Company")  + labs(fill = "Symbol")
  })
output$EPSbycompany <- renderPlot({
    ggplot(data = metrics, 
           aes(x=Symbol, y=EPS, fill=Symbol))+
      geom_bar(position = "dodge", stat = "identity") + ylab("EPS Estimate Next Year") + 
      xlab("Company") + theme(legend.position="right" 
                              ,plot.title = element_text(size=15, face="bold")) + 
      ggtitle("EPS by Company") + labs(fill = "Symbol")
  })
}

Run Dashboard

shinyApp(ui, server)

Shiny applications not supported in static R Markdown documents