inst/equity-research/app.R
In zac-garland/equityresearch: Equity Research in R
library(shiny)
library(shinydashboard)
library(equityresearch)
library(shinycssloaders)
# Header ------------------------------------------------
header <- dashboardHeader(title = shiny::tags$a(shiny::tags$img(src = "logo_r_equity_research.svg",width = "200",height = "31")))
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(
sidebarSearchForm(textId = "ticker_1", buttonId = "searchButton",
label = "Ticker..." ),
sidebarMenu(id = 'sidebarmenu',
# Equity Overview -------------------------
menuItem('Watchlist',
tabName = 'overview',
icon = icon('dedent'),
menuSubItem("Watchlist",
tabName = 'watchlist'),
conditionalPanel("input.sidebarmenu === 'watchlist'",
selectizeInput(inputId = 'sector_perf_filter',
label ="Sector Returns Period:",
choices = c("Real-Time Performance",
"1 Day Performance",
"5 Day Performance",
"1 Month Performance",
"3 Month Performance",
"Year-to-Date (YTD) Performance",
"1 Year Performance",
"3 Year Performance", "5 Year Performance",
"10 Year Performance"),
selected = "Real-Time Performance"))
),
# News--------------------
menuItem('Equity Overview',
tabName = 'news',
icon = icon('newspaper-o'),
menuSubItem("Overview",
tabName = "news_dt"),
conditionalPanel("input.sidebarmenu === 'news_dt'",
selectizeInput(inputId = 'news_sources',
label = 'News Sources',
choices = c("Seeking Alpha" = "seekingalpha.com",
"The Motley Fool" = "fool.com",
"Market Watch" = "marketwatch.com",
"CNBC" = "cnbc.com",
"Reuters" = "reuters.com",
"Nasdaq" = "nasdaq.com",
"Bloomberg" = "bloomberg.com",
"Yahoo Finance" = "finance.yahoo.com",
"Zacks" = "zacks.com",
"Wall Street Journal" = "wsj.com",
"Barrons" = "barrons.com"),
multiple = TRUE,
selected = NULL),
selectInput("news_lex",
"Lexicon:",
choices = c("NRC" = "nrc",
"Bing" = "bing",
"AFINN" = "afinn",
"Loughran" = "loughran")),
checkboxInput(inputId = "sent_filt",value = FALSE,
label = "Use Lexicon")
)),
# Technical Indicators--------------------
menuItem("Technical Indicators",
tabName = 'tech_chart',
icon = icon('random'),
dateRangeInput("tech_date_range",
"Date range:",
start = Sys.Date() %m-% years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
menuSubItem("RSI","tab_ind_rsi"),
menuSubItem("MACD","tab_ind_macd"),
menuSubItem("Bollinger Bands","tab_ind_bbands"),
menuSubItem("Stochastic Oscillator","tab_ind_stoch"),
menuSubItem("Commondity Channel Index","tab_ind_cci"),
menuSubItem("AROON","tab_ind_aroon"),
menuSubItem("On Balance Volume","tab_ind_obv"),
menuSubItem("ADX","tab_ind_adx"),
menuSubItem("Simple MA","tab_ind_sma"),
menuSubItem("Exponential MA", "tab_ind_ema"),
conditionalPanel("input.sidebarmenu === 'tab_ind_rsi'",
numericInput("rsi_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_macd'",
numericInput("macd_nfast","Fast:",value = 12),
numericInput("macd_nslow","Slow:",value = 26),
numericInput("macd_nsig","Signal:",value = 9)),
conditionalPanel("input.sidebarmenu === 'tab_ind_bbands'",
numericInput("bbands_n","Periods:",value = 20),
numericInput("bbands_sd", "Std Dev:", value = 2)),
conditionalPanel("input.sidebarmenu === 'tab_ind_stoch'",
numericInput("stoch_fastk","Fast K:",value = 14),
numericInput("stoch_fastd", "Fast D",value = 3),
numericInput("stoch_slowd","Slow D",value = 3)),
conditionalPanel("input.sidebarmenu === 'tab_ind_cci'",
numericInput("cci_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_aroon'",
numericInput("aroon_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_adx'",
numericInput("adx_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_sma'",
numericInput("sma_one","Periods:",value = 50),
numericInput("sma_two","Periods:",value = 200)),
conditionalPanel("input.sidebarmenu === 'tab_ind_ema'",
numericInput("ema_one","Periods:",value = 20),
numericInput("ema_two","Periods:",value = 50))
),
# Pricing Data-----------------------
menuItem('Prices, Risk, & Returns',
tabName = 'pricing_data',
icon = icon('line-chart'),
menuSubItem("Pricing Data",
tabName = 'price_data'),
conditionalPanel("input.sidebarmenu === 'price_data'",
dateRangeInput("price_date_range",
"Date range:",
start = Sys.Date() - years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date())
),
# Returns Data --------------------
menuSubItem('Risk & Returns Data',
tabName = 'returns_data'),
conditionalPanel("input.sidebarmenu === 'returns_data'",
textInput("returns_benchmark",
label = "Benchmark",
value = "SPY"),
dateRangeInput("returns_date_range",
"Date range:",
start = Sys.Date() - years(2),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
selectInput("returns_freq", "Chart Frequency:",
c("Daily" = "daily",
"Monthly" = "monthly",
"Yearly" = "yearly"),"daily")
)),
# Filings------------------------------
menuItem('Filings',
tabName = 'Filings',
icon = icon('file'),
menuSubItem("Transcripts",
tabName = "tra_script"),
# conditionalPanel("input.sidebarmenu === 'tra_script'",
# textInput("search", "Search")),
menuSubItem("10-K's and Q's",
tabName = "ten_k_q"),
menuSubItem("8-K",
tabName = "eight_k"),
menuSubItem("Prospectus'",
tabName = "prospectus"),
menuSubItem("Proxy Statements",
tabName = "proxy"),
menuSubItem("Beneficial Ownership",
tabName = "thirteen"))
))
# Body ------------------------------------------------
body <- dashboardBody(shiny::tags$script(HTML("$('body').addClass('sidebar-mini');")),
# shiny::tags$style(HTML("")),
shiny::tags$style(".nav-tabs {background: #f4f4f4;}
.nav-tabs-custom .nav-tabs li.active:hover a, .nav-tabs
custom .nav-tabs li.active a {background-color: transparent;
border-color: transparent;
}
.nav-tabs-custom .nav-tabs li.active {border-top-color:
#314a6d;
}"
),
# Equity Overview ----------------------------------
tabItems(
tabItem(tabName = "watchlist",
fluidRow(
column(6,
tabBox(id = "tabset_watch",
height = "550px",
width = 12,
tabPanel("Watchlist",
withSpinner(dataTableOutput("watchlist_dt")))
)),
column(6,
tabBox(id = "tabset_2",
height = "550px",
width = 12,
tabPanel("Top % Chg",
br(),
br(),
withSpinner(plotlyOutput("top_btm_chart"))),
tabPanel("News",
withSpinner(dataTableOutput("watchlist_news_dt"))),
tabPanel("Intraday",
withSpinner(highchartOutput("intraday_chart"))),
tabPanel("Return Stats",
fluidRow(column(1),
column(5,
br(),
withSpinner(htmlOutput("return_stats_one"))),
# column(1),
column(6,
br(),
withSpinner(htmlOutput("return_stats_two"))))
# , output
),
tabPanel("Key Stats",
br(),
br(),
withSpinner(dataTableOutput("key_stats")))
))
),
fluidRow(
column(12,
tabBox(id = "watchlist_4",
height = "750px",
width = 12,
tabPanel("Relative Perf",
withSpinner(plotlyOutput("ret_perf", height = "750px")))
)))
),
tabItem(tabName = "equity_overview",
fluidRow(column(7,h2(textOutput("company_name")))),
fluidRow(column(2,h2(textOutput("current_price"))),
column(1,h2(htmlOutput("price_chg"))),
column(2, h2(htmlOutput("pct_chg"))),
column(3,h3(textOutput("as_of"))),
column(2,h3(textOutput("currency_in")))),
fluidRow(column(12,withSpinner(highchartOutput("stock_chart")))),
fluidRow(column(12,dataTableOutput("equity_stats")))
),
# Technical Indicators---------------
tabItem(tabName = "tab_ind_sma",
fluidRow(column(12, withSpinner(highchartOutput("ind_sma", height = "850px"))))),
tabItem(tabName = "tab_ind_ema",
fluidRow(column(12, withSpinner(highchartOutput("ind_ema", height = "850px"))))),
tabItem(tabName = "tab_ind_macd",
fluidRow(column(12, withSpinner(highchartOutput("ind_macd", height = "850px"))))),
tabItem(tabName = "tab_ind_stoch",
fluidRow(column(12, withSpinner(highchartOutput("ind_stoch", height = "850px"))))),
tabItem(tabName = "tab_ind_rsi",
fluidRow(column(12, withSpinner(highchartOutput("ind_rsi", height = "850px"))))),
tabItem(tabName = "tab_ind_cci",
fluidRow(column(12, withSpinner(highchartOutput("ind_cci", height = "850px"))))),
tabItem(tabName = "tab_ind_aroon",
fluidRow(column(12, withSpinner(highchartOutput("ind_aroon", height = "850px"))))),
tabItem(tabName = "tab_ind_obv",
fluidRow(column(12, withSpinner(highchartOutput("ind_obv", height = "850px"))))),
tabItem(tabName = "tab_ind_adx",
fluidRow(column(12, withSpinner(highchartOutput("ind_adx", height = "850px"))))),
tabItem(tabName = "tab_ind_bbands",
fluidRow(column(12, withSpinner(highchartOutput("ind_bbands", height = "850px"))))),
# Pricing Data ----------------------------------
tabItem(tabName = "price_data",
fluidRow(column(12,withSpinner(highchartOutput("price_chart")))),
half_row(rHandsontableOutput("pricing_dt", height = "600px"),
plotlyOutput("div_plot", height = "600px"))
),
# Returns Data ----------------------------------
tabItem(tabName = "returns_data",
withSpinner(fluidRow(column(2,br(),htmlOutput("returns_dt")),
column(10,
DTOutput("key_returns"),
br(),
plotlyOutput("performance_chart"),
br(),
DTOutput("calendar_returns"))))
),
# News-------------------------------------------
tabItem(tabName = "news_dt",
fluidRow(column(6,h2(textOutput("title_1")),
withSpinner(dataTableOutput("key_info"))),
column(6,
h2(textOutput("title_3")),
br(),
withSpinner(htmlOutput("descrip")))
),
fluidRow(column(5,h2(textOutput("title_2")),
rHandsontableOutput("ticker_comps_tbl")),
column(7,h2(textOutput("title_4")),
br(),br(),br(),wordcloud2Output("news_cloud"))),
fluidRow(column(12,withSpinner(DT::DTOutput("news_dtt"))))
),
# Portfolio Optimization----------------------------
tabItem(tabName = "tab_markowitz_optimization",
fluidRow(column(12,plotlyOutput("markowitz_optimization", height = "850px")))),
tabItem(tabName = "tab_backtesting_mo",
fluidRow(column(12,plotlyOutput("backtesting_mo", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier",
fluidRow(column(12,plotlyOutput("efficient_frontier", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier_constraints",
fluidRow(column(12,plotlyOutput("efficient_frontier_constraints", height = "850px")))),
tabItem(tabName = "tab_portfolio_analytics",
fluidRow(column(6,plotlyOutput("portfolio_analytics_min_sd", height = "850px")),
column(6,plotlyOutput("portfolio_analytics_min_es", height = "850px")))),
tabItem(tabName = "tab_compare_risk",
fluidRow(column(12,plotlyOutput("compare_risk_measures", height = "850px")))),
tabItem(tabName = "tab_active_extension",
fluidRow(column(12,plotlyOutput("active_extension", height = "850px")))),
# Filings -----------------------------------
tabItem(tabName = "tra_script",
full_row(wordcloud2Output("word_cloud",height = "500px")),
# half_row(dataTableOutput("tr_df"),plotlyOutput("sent_chart", height ="auto")),
# full_row(),
full_row(br()),
full_row(br()),
full_row(plotlyOutput("sent_chart", height ="500px", width = "100%")),
full_row(br()),
full_row(br()),
# full_row(),
full_row(textInput("search", "Search")),
full_row(htmlOutput("some_text"))
),
tabItem(tabName = "ten_k_q",
full_row(withSpinner(plotlyOutput("ten_k_plot"))),
fluidRow(column(12,dataTableOutput("ten_k_q_table")))
),
tabItem(tabName = "eight_k",
full_row(withSpinner(plotlyOutput("eight_k_plot"))),
fluidRow(column(12,dataTableOutput("eight_k_table")))
),
tabItem(tabName = "prospectus",
full_row(withSpinner(plotlyOutput("pros_plot"))),
fluidRow(column(12,dataTableOutput("prospectus_table")))
),
tabItem(tabName = "proxy",
full_row(withSpinner(plotlyOutput("proxy_plot"))),
fluidRow(column(12,dataTableOutput("proxy_table")))
),
tabItem(tabName = "thirteen",
full_row(withSpinner(plotlyOutput("thirteen_plot"))),
fluidRow(column(12,dataTableOutput("thirteen_table")))
),
# Ownership ---------------------------------------------
tabItem(tabName = "ownership",
fluidRow(column(6,withSpinner(plotlyOutput("top_5_pie", height = "500px")), type = 2),
column(6,withSpinner(plotlyOutput("top_5_ts", height = "500px")),type = 2)),
fluidRow(column(12,DTOutput("inst_own_dt")))
),
# Screening---------------------------------------------
tabItem(
tabName = "constits",
fluidRow(class = "text-center",column(12,h3(textOutput("index_name")))),
half_row(br(),br()),
half_row(withSpinner(highchartOutput("index_tree")),
withSpinner(plotlyOutput("index_top"))),
full_row(br()),
full_row(withSpinner(dataTableOutput("index_screen")))
),
tabItem(
tabName = "screen",
fluidRow(
tabBox(id = "screen_tab_box",
width = 12,
tabPanel("Screen",
fluidRow(column(3,rHandsontableOutput("hot_three")),
column(9,withSpinner(rHandsontableOutput("filtered_results_r",
height = "900px"))))),
tabPanel("Visualize",
full_row(uiOutput("hist_select")),
half_row(withSpinner(plotlyOutput("screen_box")),withSpinner(plotlyOutput("screen_hist"))),
half_row(br(),br()),
fluidRow(column(6,plotlyOutput("screen_perf")),
column(6,highchartOutput("screen_tree"))))
))
),
tabItem(
tabName = "hc",
tabBox(id = "hc_tab",
width = 12,
tabPanel("Cluster Cor",
full_row(withSpinner(rHandsontableOutput("cor_mx", height = "1500px")))),
tabPanel("Risk / Returns",
fluidRow(column(2,br(),withSpinner(htmlOutput("clust_returns_dt"))),
column(10,
withSpinner(highchartOutput("clust_tree")),
br(),
withSpinner(plotlyOutput("ret_filt"))))
),
tabPanel("Current Screen",
full_row(withSpinner(rHandsontableOutput("clust_screen", height = "900px")))))
)
))
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(title = "Equity Research",
header,
sidebar,
body,
skin = "black"
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
output$watchlist_dt <- renderDataTable({
q_quotes %>%
arrange(desc(pct_chg)) %>%
mutate(green_red = as.numeric(ifelse(chg>0,1,0))) %>%
datatable(rownames = F,
selection = 'single',
options = list(scrollX = TRUE,
columnDefs = list(list(targets = 9, visible = FALSE))
)) %>%
formatPercentage("pct_chg",2) %>%
formatStyle(c('pct_chg'),'green_red',
backgroundColor = styleEqual(c(1, 0), c('rgba(50, 171, 96, 0.5)', 'rgba(219, 64, 82, 0.5)')))
})
output$intraday_chart <- renderHighchart({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Intraday Performance"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
int_day <- tq_get(ticker,
get = "alphavantager",
av_fun = "TIME_SERIES_INTRADAY",
interval = "15min",
outputsize = "full")
int_day_xts <- xts(int_day[,-1],order.by = int_day$timestamp)
highchart() %>%
hc_add_series_ohlc(int_day_xts,
name = ticker) %>%
hc_rangeSelector( buttons = list(
list(type = 'all', text = 'All'),
list(type = 'hour', count = 2, text = '2h'),
list(type = 'day', count = 1, text = '1d'),
list(type = 'day', count = 3, text = '3d'),
list(type = 'day', count = 10, text = '10d'),
list(type = 'day', count = 30, text = '30d')
)) %>%
hc_tooltip(valueDecimals = "2")
})
output$top_btm_chart <- renderPlotly({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to Compare Performance"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_quotes <- q_quotes %>%
mutate(rank = min_rank(desc(pct_chg))) %>% filter(rank <= 5 | rank >= (max(rank,na.rm=T)-5)) %>% select(-rank)
q_quotes %>%
arrange(pct_chg) %>%
mutate(color = ifelse(pct_chg>0,'rgba(50, 171, 96, 0.7)', 'rgba(219, 64, 82, 0.7)')) %>%
mutate(symbol = as_factor(symbol)) %>%
plot_ly(x = ~pct_chg,
y = ~symbol,
type = 'bar',
orientation = 'h',
marker = list(color = ~color)) %>%
add_annotations(x = q_quotes$pct_chg/2,
y = q_quotes$symbol,
text = q_quotes$symbol,
xref = "x",
yref = "y",
showarrow = F,
font = list(color = '#ffffff',
family = 'sans serif',
size = 20)) %>%
layout(xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
zeroline = F,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE),
showlegend = F)
})
output$watchlist_news_dt <- DT::renderDataTable({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Company News"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
company_news <- q_news(ticker) %>%
dplyr::select(title,description,source,published_date,url) %>%
dplyr::mutate(description = ifelse(str_length(description)>=350,
paste0(str_sub(description,1,350),
"..."),
description)) %>%
mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
dplyr::select(-url,-description)
dt <- company_news %>%
DT::datatable(rownames = F,selection = 'single',
escape = F,
class = 'cell-border stripe',
extensions = c('ColReorder','Scroller'),
options = list(colReorder = TRUE,
deferRender = T,
pageLength = 5))
dt %>% formatDate(4,'toUTCString') %>%
DT::formatStyle(columns = 1, fontSize = '20px')
})
output$sector_returns_chart <- renderPlotly({
# sector_returns <- tq_get("SECTOR",get = "alphavantager",av_fun = "SECTOR") %>%
# dplyr::mutate(category = str_sub(rank.group,9,str_length(rank.group))) %>%
# dplyr::select(category,sector,value)
filt_return <- sec_rets %>%
filter(category == input$sector_perf_filter) %>%
left_join(sector_color_map, by = "sector") %>%
mutate(value = value/100) %>%
arrange(value) %>%
dplyr::mutate(sector = as_factor(sector))
filt_return %>%
plot_ly(x = ~value,
y = ~sector,
type = 'bar',
orientation = "h",
color = ~sector,
showlegend = F,
colors = adjustcolor(brewer.pal(11,"RdBu"),alpha.f = 0.8)) %>%
layout(xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(type = "category",
title = ""))
})
output$return_stats_one <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_one(ticker,"SPY")
})
output$return_stats_two <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_two(ticker,"SPY")
})
# Performance Chart-----------------------------
output$ret_perf <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
ticks <- c(ticker,"SPY")
# plot -----------------------
plot.df <- q_price(ticks,
start_date = Sys.Date() - years(2),
frequency = "daily")%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = "daily",
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,"Daily Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = ""))
})
output$key_stats <- renderDataTable({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Key Stats"))
# Yahoooo Key Stats
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- q_key_stats(ticker)
DT::datatable(df,
colnames = c("","","",""),
rownames = FALSE,
selection = 'none', options = list(dom = 't',
bSort=FALSE,
columnDefs = list(
list(className = 'dt-right', targets = c(1,3)))))
})
output$filing_short <- renderDataTable({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
filings <- company_filings(ticker , count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$own_pie <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- Quandl.datatable("SHARADAR/SF3", ticker = ticker,
paginate = T, securitytype = "SHR",
calendardate.gte=as.character(Sys.Date()-days(180))) %>%
filter(calendardate == max(calendardate)) %>%
select(-c(ticker,securitytype)) %>%
as_tibble()
all_sh_sum <- sum(df$value)
inst_data <- df %>%
mutate(top_5 = ifelse(min_rank(desc(value))<= 5, investorname,"OTHER")) %>%
group_by(top_5) %>%
summarize(pct_by_group = sum(value,na.rm = T)/all_sh_sum) %>%
mutate(lev = ifelse(top_5 == "Other",dplyr::n()+1,min_rank(desc(pct_by_group)))) %>%
arrange(lev) %>%
mutate(top_5 = factor(top_5,unique(top_5)))
inst_data %>%
plot_ly(labels = ~top_5,
values = ~pct_by_group,
type = 'pie')
})
# Equity Overview Script ----------------------------------------
output$title_1 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Info")
})
output$title_3 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Description")
})
output$key_info <- renderDataTable({
req(input$ticker_1)
if (is.null(quandl_api_key())){
return(warning("No Quandl API key detected. Limited to 50 anonymous calls per day. Set key with 'quandl_api_key()'.",
call. = FALSE))
}
key_info <- Quandl.datatable("SHARADAR/TICKERS",ticker = input$ticker_1) %>%
filter(table == "SF1") %>%
select(ticker,name,exchange,sicsector,sicindustry,location,secfilings,companysite) %>%
rename(sector = sicsector,
industry = sicindustry) %>%
gather(key,value)
key_info %>%
bind_cols(q_key_stats(input$ticker_1)) %>%
mutate(value = ifelse(key %in% c("secfilings","companysite"),
paste0("<a href='",value,"' target='_blank'>","Link","</a>"),
value)) %>%
mutate(key = str_to_title(key)) %>%
as_tibble() %>%
datatable(rownames = F,
colnames=c("", "","","","",""),
escape = F,
options = list(dom = 't',ordering=F))
})
output$descrip <- renderText({
req(input$ticker_1)
paste0("<h4>",q_descrip(input$ticker_1),"</h4>")
})
# Technical Indicators------------------------------------------------
tech_price <- reactive({
req(input$ticker_1)
req(input$tech_date_range)
tq_get(input$ticker_1, from = input$tech_date_range[[1]] %m-% years(1),
to = input$tech_date_range[[2]])
})
# SMA(x, n = 10, ...)
output$ind_sma <- renderHighchart({
req(input$sma_one)
req(input$sma_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_one, col_rename = "sma_50") %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_two, col_rename = "sma_200") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
sma_one_name <- paste0(input$sma_one," MA")
sma_two_name <- paste0(input$sma_two," MA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$sma_50, yAxis = 0, name = sma_one_name) %>%
hc_add_series(ind_xts$sma_200,yAxis = 0, name = sma_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
# EMA(x, n = 10, wilder = FALSE, ratio = NULL, ...)
output$ind_ema <- renderHighchart({
req(input$ema_one)
req(input$ema_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_one,col_rename = "ema_20") %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_two, col_rename = "ema_50") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
ema_one_name <- paste0(input$ema_one," EMA")
ema_two_name <- paste0(input$ema_two," EMA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$ema_20, yAxis = 0, name = ema_one_name) %>%
hc_add_series(ind_xts$ema_50,yAxis = 0, name = ema_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_macd <- renderHighchart({
req(input$macd_nfast)
req(input$macd_nslow)
req(input$macd_nsig)
# MACD(x, nFast = 12, nSlow = 26, nSig = 9, maType, percent = TRUE, ...)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = MACD,
nFast = input$macd_nfast,
nSlow = input$macd_nslow,
nSig = input$macd_nsig) %>%
mutate(diff = macd - signal) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$macd, color = "blue", yAxis = 1, name = "MACD") %>%
hc_add_series(ind_xts$signal, color = "green", yAxis = 1, name = "Signal") %>%
hc_add_series(ind_xts$diff, color = "gray", yAxis = 1, type = "column", name = "Difference") %>%
hc_tooltip(valueDecimals = "2")
})
# stoch(HLC, nFastK = 14, nFastD = 3, nSlowD = 3, maType, bounded = TRUE, smooth = 1, ...)
# aapl %>% tq_mutate(select = c(high,low,close), mutate_fun = stoch)
output$ind_stoch <- renderHighchart({
req(input$stoch_fastk)
req(input$stoch_fastd)
req(input$stoch_slowd)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = stoch,
nFastK= input$stoch_fastk,
nFastD = input$stoch_fastd,
nSlowD = input$stoch_slowd) %>%
mutate(stoch = stoch *100,
lower_level = 20,
upper_level = 80) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$stoch, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# RSI(price, n=14, maType="WMA", wts=ttrc[,"Volume"])
# aapl %>% tq_mutate(select = adjusted, mutate_fun = RSI)
output$ind_rsi <- renderHighchart({
req(input$rsi_n)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = RSI,
n = input$rsi_n) %>%
mutate(lower_level = 30,
upper_level = 70) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$rsi, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# CCI(HLC, n = 20, maType, c = 0.015, ...)
output$ind_cci <- renderHighchart({
req(input$cci_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = CCI,
n = input$cci_n) %>%
mutate(lower_level = -100,
upper_level = 100) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$cci, color = "blue", yAxis = 1, name = "CCI") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, name = "Oversold",
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, name = "Overbought", tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# aroon(HL, n = 20)
# aapl %>% tq_mutate(select = c(high,low), mutate_fun = aroon)
output$ind_aroon <- renderHighchart({
req(input$aroon_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low), mutate_fun = aroon,
n = input$aroon_n) %>%
filter(date >= input$tech_date_range[[1]]) %>%
mutate(lower_level = -100,
upper_level = 100)
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$aroonUp, color = "green", yAxis = 1, name = "Up") %>%
hc_add_series(ind_xts$aroonDn, color = "red", yAxis = 1, name = "Down" ) %>%
hc_add_series(ind_xts$oscillator, color = "blue", yAxis = 2, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "black",yAxis = 2,
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 2, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# OBV(price, volume)
output$ind_obv <- renderHighchart({
ind_df <- tech_price() %>%
tq_mutate_xy(adjusted,volume, mutate_fun = OBV) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$obv, color = "blue", yAxis = 1, name = "On Balance Volume") %>%
hc_tooltip(valueDecimals = "2")
})
# Need to Join Seperately
# ADX(HLC, n = 14, maType, ...)
output$ind_adx <- renderHighchart({
req(input$adx_n)
ind_df <- tech_price() %>% tq_transmute(select = c(high,low,close), mutate_fun = ADX, n = input$adx_n) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$DIp, color = "green", yAxis = 1, name = "Positive") %>%
hc_add_series(ind_xts$DIn, color = "red", yAxis = 1, name = "Negative") %>%
hc_add_series(ind_xts$ADX, color = "black", yAxis = 2, name = "ADX") %>%
hc_add_series(ind_xts$DX, color = "blue", yAxis = 2, name = "DX") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_bbands <- renderHighchart({
req(input$bbands_n)
req(input$bbands_sd)
# BBands(HLC, n = 20, maType, sd = 2, ...)
ind_df <- tech_price() %>% tq_transmute(select = adjusted,
mutate_fun = BBands,
n= input$bbands_n,
sd= input$bbands_sd) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
mutate(upper_level = 1,
lower_level = 0) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$dn, color = "green", yAxis = 0, name = "Lower") %>%
hc_add_series(ind_xts$up, color = "red", yAxis = 0, name = "Upper") %>%
hc_add_series(ind_xts$mavg, color = "black", yAxis = 0, name = "Moving Average") %>%
hc_add_series(ind_xts$pctB, color = "blue", yAxis = 1, name = "% B") %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$lower_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_tooltip(valueDecimals = "2")
})
# Pricing Data------------------
q_pricing <- reactive({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
tq_get(input$ticker_1,
from = input$price_date_range[[1]],
to = input$price_date_range[[2]])
})
# Pricing Chart------------------------
output$price_chart <- renderHighchart({
price_dt <- q_pricing()
price_xts <- xts(price_dt[-1],price_dt$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(price_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(price_xts$volume, yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$pricing_dt <- renderRHandsontable({
q_pricing() %>%
arrange(desc(date)) %>%
rhandsontable(stretchH = "all")
})
output$div_plot <- renderPlotly({
req(input$ticker_1)
divs <- tq_get(input$ticker_1,
get = "dividends")
if("dividends" %in% colnames(divs)){
divs %>%
plot_ly(x = ~date,
y = ~dividends,
type = 'scatter',
mode = 'lines',
fill = 'tozeroy') %>%
layout(title = paste0(input$ticker_1," Dividends Over Time"),
plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
}
})
# Returns Data -----------------------------------
output$returns_dt <- renderText({
req(input$ticker_1)
req(input$returns_benchmark)
ticker <- as.character(input$ticker_1)
benchmark <- as.character(input$returns_benchmark)
q_return_stats_full(ticker,
benchmark,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]])
})
# Performance Chart-----------------------------
output$performance_chart <- renderPlotly({
req(input$ticker_1)
req(input$returns_benchmark)
ticks <- c(input$ticker_1,input$returns_benchmark)
# plot -----------------------
plot.df <- q_price(ticks,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]],
frequency = input$returns_freq)%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = input$returns_freq,
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,input$returns_freq," Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = "")) %>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
# Key Returns --------------------
output$key_returns <- renderDataTable({
req(input$ticker_1)
req(input$returns_benchmark)
tick_key_rets <- q_key_returns(input$ticker_1)
bench_key_rets <- q_key_returns(input$returns_benchmark)
tick_key_rets %>%
full_join(bench_key_rets) %>%
DT::datatable(rownames=F,options = list(dom = "t")) %>%
formatPercentage(2:11)
})
# Calendar Returns------------------
output$calendar_returns <- renderDataTable({
req(input$ticker_1)
cal_returns<- q_return(input$ticker_1,frequency = "monthly")
nms <- tibble(
mnth_abbrev = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
mnth = c(1,2,3,4,5,6,7,8,9,10,11,12))
cal_returns %>%
select(date,monthly_return) %>%
mutate(mnth = month(date),
year = year(date)) %>%
left_join(nms,by = "mnth") %>%
select(-date,-mnth) %>%
spread(mnth_abbrev,monthly_return) %>%
select(year,nms$mnth_abbrev) %>%
arrange(desc(year)) %>%
DT::datatable(rownames=F, options = list(dom = 'tp')) %>%
formatPercentage(nms$mnth_abbrev,1)
})
company_news <-reactive({
req(input$ticker_1)
q_news(input$ticker_1,
sources = input$news_sources)
})
output$ticker_comps_tbl <- renderRHandsontable({
req(input$ticker_1)
comps <- q_comps(input$ticker_1)
# row_highlight <- comps %>%
# mutate(row_n = row_number()) %>%
# filter(str_detect(ticker,input$ticker_1)) %>%
# pull(row_n)
#
# row_highlight = 4
comps %>%
rhandsontable()
})
output$news_bub <- renderBubbles({
company_news <- company_news()
company_news %>%
select(tickers) %>%
unnest() %>%
count(tickers) %>%
filter(tickers != str_to_lower(input$ticker_1)) %>%
mutate(tickers = str_to_upper(tickers)) %>%
arrange(desc(n)) %>%
slice(1:5) %>%
mutate(color = rep_len(tol12qualitative,5)) %>%
bubbles::bubbles(value = .$n,
label = .$tickers,
tooltip = .$n,
color = .$color,
textColor = "white")
# mutate(color = rep_len(brewer.pal(8,"Dark2"),15)) %>%
# bubbles::bubbles(value = .$n,label = .$tickers,
# color = .$color)
})
output$news_cloud <- renderWordcloud2({
req(input$ticker_1)
company_news <- company_news()
company_descrip <- company_news %>%
pull(description)
descrip_df <- tibble(line = 1:length(company_descrip), text = company_descrip)
text_count <- descrip_df %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
sent <- text_count %>%
inner_join(get_sentiments(input$news_lex)) %>%
count(word) %>%
rename(freq = n)
descrip_df <- descrip_df %>%
unnest_tokens(word,text) %>%
count(word) %>%
anti_join(stop_words) %>%
arrange(desc(n)) %>%
rename(freq = n)
if(input$sent_filt){
# Wordcloud
sent %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
} else{
descrip_df %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
}
})
# News DT--------------------
output$news_dtt <- DT::renderDataTable({
req(input$ticker_1)
company_news <- company_news()
company_news <- company_news %>%
dplyr::select(title,description,source,published_date,url) %>%
mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
dplyr::select(-url)
dt <- company_news %>%
DT::datatable(rownames = F,selection = 'single',
escape = F,
class = 'cell-border stripe',
options = list(
columnDefs = list(
list(width = '300px', targets = c(0,1)),
list(width = '100px', targets = c(2,3)),
list(height = '100px', targets = "_all"),
list(className = 'dt-center',targets = c(2,3)),
list(className = 'dt-right',targets = 0))))
dt %>% formatDate(4,'toUTCString') %>%
DT::formatStyle(columns = 1, fontSize = '20px')
})
text_df <- reactive({
req(input$ticker_1)
t_script <- q_transcript(input$ticker_1)
t_ext <- t_script %>%
slice(1) %>%
pull(link) %>%
read_html() %>%
html_nodes("p") %>%
html_text()
data_frame(line = 1:length(t_ext), text = t_ext)
})
sent <- reactive({
text_count <- text_df() %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
text_count %>%
inner_join(get_sentiments("loughran"))
})
output$word_cloud <- renderWordcloud2({
# sent() %>%
# count(word, sentiment, sort = TRUE) %>%
# acast(word ~ sentiment, value.var = "n", fill = 0) %>%
# comparison.cloud(colors=rev(brewer.pal(3,"Dark2")[1:2]),
# max.words = 50)
sent() %>% count(word) %>% rename(freq = n) %>% wordcloud2(size=1.3,
backgroundColor = 'rgb(236,240,245)')
})
output$sent_chart <- renderPlotly({
gg <- sent() %>%
filter(sentiment != "superfluous", sentiment != "constraining") %>%
filter(!str_detect(word,"question")) %>%
count(word,sentiment,sort = T) %>%
group_by(sentiment) %>%
slice(1:5) %>%
ungroup() %>%
# mutate(n = ifelse(sentiment=="negative",-n,n)) %>%
mutate(word = str_to_title(word)) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free") +
labs(y = NULL,
x = NULL) +
coord_flip()+
theme_minimal()
# Sentiment Plotly
ggplotly(gg)%>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
output$some_text <- renderText({
if(!is.null(input$search) & input$search != ""){
text_df <- text_df() %>%
filter(str_detect(text,input$search)) %>%
mutate(text = str_replace_all(text,input$search,paste0("<mark>",input$search,"</mark>")))
t_script <- paste(text_df$text,collapse="<br><br>")
} else {
text_df <- text_df()
t_script <- paste(text_df$text,collapse="<br><br>")
}
paste0("<h4>",t_script,"</h4>")
})
output$ten_k_q_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$ten_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$eight_k_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$eight_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$prospectus_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$pros_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$proxy_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$proxy_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$thirteen_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$thirteen_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
}))
zac-garland/equityresearch documentation built on July 30, 2020, 2:29 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(shiny)
library(shinydashboard)
library(equityresearch)
library(shinycssloaders)
# Header ------------------------------------------------
header <- dashboardHeader(title = shiny::tags$a(shiny::tags$img(src = "logo_r_equity_research.svg",width = "200",height = "31")))
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(
sidebarSearchForm(textId = "ticker_1", buttonId = "searchButton",
label = "Ticker..." ),
sidebarMenu(id = 'sidebarmenu',
# Equity Overview -------------------------
menuItem('Watchlist',
tabName = 'overview',
icon = icon('dedent'),
menuSubItem("Watchlist",
tabName = 'watchlist'),
conditionalPanel("input.sidebarmenu === 'watchlist'",
selectizeInput(inputId = 'sector_perf_filter',
label ="Sector Returns Period:",
choices = c("Real-Time Performance",
"1 Day Performance",
"5 Day Performance",
"1 Month Performance",
"3 Month Performance",
"Year-to-Date (YTD) Performance",
"1 Year Performance",
"3 Year Performance", "5 Year Performance",
"10 Year Performance"),
selected = "Real-Time Performance"))
),
# News--------------------
menuItem('Equity Overview',
tabName = 'news',
icon = icon('newspaper-o'),
menuSubItem("Overview",
tabName = "news_dt"),
conditionalPanel("input.sidebarmenu === 'news_dt'",
selectizeInput(inputId = 'news_sources',
label = 'News Sources',
choices = c("Seeking Alpha" = "seekingalpha.com",
"The Motley Fool" = "fool.com",
"Market Watch" = "marketwatch.com",
"CNBC" = "cnbc.com",
"Reuters" = "reuters.com",
"Nasdaq" = "nasdaq.com",
"Bloomberg" = "bloomberg.com",
"Yahoo Finance" = "finance.yahoo.com",
"Zacks" = "zacks.com",
"Wall Street Journal" = "wsj.com",
"Barrons" = "barrons.com"),
multiple = TRUE,
selected = NULL),
selectInput("news_lex",
"Lexicon:",
choices = c("NRC" = "nrc",
"Bing" = "bing",
"AFINN" = "afinn",
"Loughran" = "loughran")),
checkboxInput(inputId = "sent_filt",value = FALSE,
label = "Use Lexicon")
)),
# Technical Indicators--------------------
menuItem("Technical Indicators",
tabName = 'tech_chart',
icon = icon('random'),
dateRangeInput("tech_date_range",
"Date range:",
start = Sys.Date() %m-% years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
menuSubItem("RSI","tab_ind_rsi"),
menuSubItem("MACD","tab_ind_macd"),
menuSubItem("Bollinger Bands","tab_ind_bbands"),
menuSubItem("Stochastic Oscillator","tab_ind_stoch"),
menuSubItem("Commondity Channel Index","tab_ind_cci"),
menuSubItem("AROON","tab_ind_aroon"),
menuSubItem("On Balance Volume","tab_ind_obv"),
menuSubItem("ADX","tab_ind_adx"),
menuSubItem("Simple MA","tab_ind_sma"),
menuSubItem("Exponential MA", "tab_ind_ema"),
conditionalPanel("input.sidebarmenu === 'tab_ind_rsi'",
numericInput("rsi_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_macd'",
numericInput("macd_nfast","Fast:",value = 12),
numericInput("macd_nslow","Slow:",value = 26),
numericInput("macd_nsig","Signal:",value = 9)),
conditionalPanel("input.sidebarmenu === 'tab_ind_bbands'",
numericInput("bbands_n","Periods:",value = 20),
numericInput("bbands_sd", "Std Dev:", value = 2)),
conditionalPanel("input.sidebarmenu === 'tab_ind_stoch'",
numericInput("stoch_fastk","Fast K:",value = 14),
numericInput("stoch_fastd", "Fast D",value = 3),
numericInput("stoch_slowd","Slow D",value = 3)),
conditionalPanel("input.sidebarmenu === 'tab_ind_cci'",
numericInput("cci_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_aroon'",
numericInput("aroon_n","Periods:",value = 20)),
conditionalPanel("input.sidebarmenu === 'tab_ind_adx'",
numericInput("adx_n","Periods:",value = 14)),
conditionalPanel("input.sidebarmenu === 'tab_ind_sma'",
numericInput("sma_one","Periods:",value = 50),
numericInput("sma_two","Periods:",value = 200)),
conditionalPanel("input.sidebarmenu === 'tab_ind_ema'",
numericInput("ema_one","Periods:",value = 20),
numericInput("ema_two","Periods:",value = 50))
),
# Pricing Data-----------------------
menuItem('Prices, Risk, & Returns',
tabName = 'pricing_data',
icon = icon('line-chart'),
menuSubItem("Pricing Data",
tabName = 'price_data'),
conditionalPanel("input.sidebarmenu === 'price_data'",
dateRangeInput("price_date_range",
"Date range:",
start = Sys.Date() - years(1),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date())
),
# Returns Data --------------------
menuSubItem('Risk & Returns Data',
tabName = 'returns_data'),
conditionalPanel("input.sidebarmenu === 'returns_data'",
textInput("returns_benchmark",
label = "Benchmark",
value = "SPY"),
dateRangeInput("returns_date_range",
"Date range:",
start = Sys.Date() - years(2),
end = Sys.Date(),
min = "2000-01-01",
max = Sys.Date()),
selectInput("returns_freq", "Chart Frequency:",
c("Daily" = "daily",
"Monthly" = "monthly",
"Yearly" = "yearly"),"daily")
)),
# Filings------------------------------
menuItem('Filings',
tabName = 'Filings',
icon = icon('file'),
menuSubItem("Transcripts",
tabName = "tra_script"),
# conditionalPanel("input.sidebarmenu === 'tra_script'",
# textInput("search", "Search")),
menuSubItem("10-K's and Q's",
tabName = "ten_k_q"),
menuSubItem("8-K",
tabName = "eight_k"),
menuSubItem("Prospectus'",
tabName = "prospectus"),
menuSubItem("Proxy Statements",
tabName = "proxy"),
menuSubItem("Beneficial Ownership",
tabName = "thirteen"))
))
# Body ------------------------------------------------
body <- dashboardBody(shiny::tags$script(HTML("$('body').addClass('sidebar-mini');")),
# shiny::tags$style(HTML("")),
shiny::tags$style(".nav-tabs {background: #f4f4f4;}
.nav-tabs-custom .nav-tabs li.active:hover a, .nav-tabs
custom .nav-tabs li.active a {background-color: transparent;
border-color: transparent;
}
.nav-tabs-custom .nav-tabs li.active {border-top-color:
#314a6d;
}"
),
# Equity Overview ----------------------------------
tabItems(
tabItem(tabName = "watchlist",
fluidRow(
column(6,
tabBox(id = "tabset_watch",
height = "550px",
width = 12,
tabPanel("Watchlist",
withSpinner(dataTableOutput("watchlist_dt")))
)),
column(6,
tabBox(id = "tabset_2",
height = "550px",
width = 12,
tabPanel("Top % Chg",
br(),
br(),
withSpinner(plotlyOutput("top_btm_chart"))),
tabPanel("News",
withSpinner(dataTableOutput("watchlist_news_dt"))),
tabPanel("Intraday",
withSpinner(highchartOutput("intraday_chart"))),
tabPanel("Return Stats",
fluidRow(column(1),
column(5,
br(),
withSpinner(htmlOutput("return_stats_one"))),
# column(1),
column(6,
br(),
withSpinner(htmlOutput("return_stats_two"))))
# , output
),
tabPanel("Key Stats",
br(),
br(),
withSpinner(dataTableOutput("key_stats")))
))
),
fluidRow(
column(12,
tabBox(id = "watchlist_4",
height = "750px",
width = 12,
tabPanel("Relative Perf",
withSpinner(plotlyOutput("ret_perf", height = "750px")))
)))
),
tabItem(tabName = "equity_overview",
fluidRow(column(7,h2(textOutput("company_name")))),
fluidRow(column(2,h2(textOutput("current_price"))),
column(1,h2(htmlOutput("price_chg"))),
column(2, h2(htmlOutput("pct_chg"))),
column(3,h3(textOutput("as_of"))),
column(2,h3(textOutput("currency_in")))),
fluidRow(column(12,withSpinner(highchartOutput("stock_chart")))),
fluidRow(column(12,dataTableOutput("equity_stats")))
),
# Technical Indicators---------------
tabItem(tabName = "tab_ind_sma",
fluidRow(column(12, withSpinner(highchartOutput("ind_sma", height = "850px"))))),
tabItem(tabName = "tab_ind_ema",
fluidRow(column(12, withSpinner(highchartOutput("ind_ema", height = "850px"))))),
tabItem(tabName = "tab_ind_macd",
fluidRow(column(12, withSpinner(highchartOutput("ind_macd", height = "850px"))))),
tabItem(tabName = "tab_ind_stoch",
fluidRow(column(12, withSpinner(highchartOutput("ind_stoch", height = "850px"))))),
tabItem(tabName = "tab_ind_rsi",
fluidRow(column(12, withSpinner(highchartOutput("ind_rsi", height = "850px"))))),
tabItem(tabName = "tab_ind_cci",
fluidRow(column(12, withSpinner(highchartOutput("ind_cci", height = "850px"))))),
tabItem(tabName = "tab_ind_aroon",
fluidRow(column(12, withSpinner(highchartOutput("ind_aroon", height = "850px"))))),
tabItem(tabName = "tab_ind_obv",
fluidRow(column(12, withSpinner(highchartOutput("ind_obv", height = "850px"))))),
tabItem(tabName = "tab_ind_adx",
fluidRow(column(12, withSpinner(highchartOutput("ind_adx", height = "850px"))))),
tabItem(tabName = "tab_ind_bbands",
fluidRow(column(12, withSpinner(highchartOutput("ind_bbands", height = "850px"))))),
# Pricing Data ----------------------------------
tabItem(tabName = "price_data",
fluidRow(column(12,withSpinner(highchartOutput("price_chart")))),
half_row(rHandsontableOutput("pricing_dt", height = "600px"),
plotlyOutput("div_plot", height = "600px"))
),
# Returns Data ----------------------------------
tabItem(tabName = "returns_data",
withSpinner(fluidRow(column(2,br(),htmlOutput("returns_dt")),
column(10,
DTOutput("key_returns"),
br(),
plotlyOutput("performance_chart"),
br(),
DTOutput("calendar_returns"))))
),
# News-------------------------------------------
tabItem(tabName = "news_dt",
fluidRow(column(6,h2(textOutput("title_1")),
withSpinner(dataTableOutput("key_info"))),
column(6,
h2(textOutput("title_3")),
br(),
withSpinner(htmlOutput("descrip")))
),
fluidRow(column(5,h2(textOutput("title_2")),
rHandsontableOutput("ticker_comps_tbl")),
column(7,h2(textOutput("title_4")),
br(),br(),br(),wordcloud2Output("news_cloud"))),
fluidRow(column(12,withSpinner(DT::DTOutput("news_dtt"))))
),
# Portfolio Optimization----------------------------
tabItem(tabName = "tab_markowitz_optimization",
fluidRow(column(12,plotlyOutput("markowitz_optimization", height = "850px")))),
tabItem(tabName = "tab_backtesting_mo",
fluidRow(column(12,plotlyOutput("backtesting_mo", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier",
fluidRow(column(12,plotlyOutput("efficient_frontier", height = "850px")))),
tabItem(tabName = "tab_efficient_frontier_constraints",
fluidRow(column(12,plotlyOutput("efficient_frontier_constraints", height = "850px")))),
tabItem(tabName = "tab_portfolio_analytics",
fluidRow(column(6,plotlyOutput("portfolio_analytics_min_sd", height = "850px")),
column(6,plotlyOutput("portfolio_analytics_min_es", height = "850px")))),
tabItem(tabName = "tab_compare_risk",
fluidRow(column(12,plotlyOutput("compare_risk_measures", height = "850px")))),
tabItem(tabName = "tab_active_extension",
fluidRow(column(12,plotlyOutput("active_extension", height = "850px")))),
# Filings -----------------------------------
tabItem(tabName = "tra_script",
full_row(wordcloud2Output("word_cloud",height = "500px")),
# half_row(dataTableOutput("tr_df"),plotlyOutput("sent_chart", height ="auto")),
# full_row(),
full_row(br()),
full_row(br()),
full_row(plotlyOutput("sent_chart", height ="500px", width = "100%")),
full_row(br()),
full_row(br()),
# full_row(),
full_row(textInput("search", "Search")),
full_row(htmlOutput("some_text"))
),
tabItem(tabName = "ten_k_q",
full_row(withSpinner(plotlyOutput("ten_k_plot"))),
fluidRow(column(12,dataTableOutput("ten_k_q_table")))
),
tabItem(tabName = "eight_k",
full_row(withSpinner(plotlyOutput("eight_k_plot"))),
fluidRow(column(12,dataTableOutput("eight_k_table")))
),
tabItem(tabName = "prospectus",
full_row(withSpinner(plotlyOutput("pros_plot"))),
fluidRow(column(12,dataTableOutput("prospectus_table")))
),
tabItem(tabName = "proxy",
full_row(withSpinner(plotlyOutput("proxy_plot"))),
fluidRow(column(12,dataTableOutput("proxy_table")))
),
tabItem(tabName = "thirteen",
full_row(withSpinner(plotlyOutput("thirteen_plot"))),
fluidRow(column(12,dataTableOutput("thirteen_table")))
),
# Ownership ---------------------------------------------
tabItem(tabName = "ownership",
fluidRow(column(6,withSpinner(plotlyOutput("top_5_pie", height = "500px")), type = 2),
column(6,withSpinner(plotlyOutput("top_5_ts", height = "500px")),type = 2)),
fluidRow(column(12,DTOutput("inst_own_dt")))
),
# Screening---------------------------------------------
tabItem(
tabName = "constits",
fluidRow(class = "text-center",column(12,h3(textOutput("index_name")))),
half_row(br(),br()),
half_row(withSpinner(highchartOutput("index_tree")),
withSpinner(plotlyOutput("index_top"))),
full_row(br()),
full_row(withSpinner(dataTableOutput("index_screen")))
),
tabItem(
tabName = "screen",
fluidRow(
tabBox(id = "screen_tab_box",
width = 12,
tabPanel("Screen",
fluidRow(column(3,rHandsontableOutput("hot_three")),
column(9,withSpinner(rHandsontableOutput("filtered_results_r",
height = "900px"))))),
tabPanel("Visualize",
full_row(uiOutput("hist_select")),
half_row(withSpinner(plotlyOutput("screen_box")),withSpinner(plotlyOutput("screen_hist"))),
half_row(br(),br()),
fluidRow(column(6,plotlyOutput("screen_perf")),
column(6,highchartOutput("screen_tree"))))
))
),
tabItem(
tabName = "hc",
tabBox(id = "hc_tab",
width = 12,
tabPanel("Cluster Cor",
full_row(withSpinner(rHandsontableOutput("cor_mx", height = "1500px")))),
tabPanel("Risk / Returns",
fluidRow(column(2,br(),withSpinner(htmlOutput("clust_returns_dt"))),
column(10,
withSpinner(highchartOutput("clust_tree")),
br(),
withSpinner(plotlyOutput("ret_filt"))))
),
tabPanel("Current Screen",
full_row(withSpinner(rHandsontableOutput("clust_screen", height = "900px")))))
)
))
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(title = "Equity Research",
header,
sidebar,
body,
skin = "black"
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
output$watchlist_dt <- renderDataTable({
q_quotes %>%
arrange(desc(pct_chg)) %>%
mutate(green_red = as.numeric(ifelse(chg>0,1,0))) %>%
datatable(rownames = F,
selection = 'single',
options = list(scrollX = TRUE,
columnDefs = list(list(targets = 9, visible = FALSE))
)) %>%
formatPercentage("pct_chg",2) %>%
formatStyle(c('pct_chg'),'green_red',
backgroundColor = styleEqual(c(1, 0), c('rgba(50, 171, 96, 0.5)', 'rgba(219, 64, 82, 0.5)')))
})
output$intraday_chart <- renderHighchart({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Intraday Performance"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
int_day <- tq_get(ticker,
get = "alphavantager",
av_fun = "TIME_SERIES_INTRADAY",
interval = "15min",
outputsize = "full")
int_day_xts <- xts(int_day[,-1],order.by = int_day$timestamp)
highchart() %>%
hc_add_series_ohlc(int_day_xts,
name = ticker) %>%
hc_rangeSelector( buttons = list(
list(type = 'all', text = 'All'),
list(type = 'hour', count = 2, text = '2h'),
list(type = 'day', count = 1, text = '1d'),
list(type = 'day', count = 3, text = '3d'),
list(type = 'day', count = 10, text = '10d'),
list(type = 'day', count = 30, text = '30d')
)) %>%
hc_tooltip(valueDecimals = "2")
})
output$top_btm_chart <- renderPlotly({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to Compare Performance"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_quotes <- q_quotes %>%
mutate(rank = min_rank(desc(pct_chg))) %>% filter(rank <= 5 | rank >= (max(rank,na.rm=T)-5)) %>% select(-rank)
q_quotes %>%
arrange(pct_chg) %>%
mutate(color = ifelse(pct_chg>0,'rgba(50, 171, 96, 0.7)', 'rgba(219, 64, 82, 0.7)')) %>%
mutate(symbol = as_factor(symbol)) %>%
plot_ly(x = ~pct_chg,
y = ~symbol,
type = 'bar',
orientation = 'h',
marker = list(color = ~color)) %>%
add_annotations(x = q_quotes$pct_chg/2,
y = q_quotes$symbol,
text = q_quotes$symbol,
xref = "x",
yref = "y",
showarrow = F,
font = list(color = '#ffffff',
family = 'sans serif',
size = 20)) %>%
layout(xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
zeroline = F,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE),
showlegend = F)
})
output$watchlist_news_dt <- DT::renderDataTable({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Company News"))
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
company_news <- q_news(ticker) %>%
dplyr::select(title,description,source,published_date,url) %>%
dplyr::mutate(description = ifelse(str_length(description)>=350,
paste0(str_sub(description,1,350),
"..."),
description)) %>%
mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
dplyr::select(-url,-description)
dt <- company_news %>%
DT::datatable(rownames = F,selection = 'single',
escape = F,
class = 'cell-border stripe',
extensions = c('ColReorder','Scroller'),
options = list(colReorder = TRUE,
deferRender = T,
pageLength = 5))
dt %>% formatDate(4,'toUTCString') %>%
DT::formatStyle(columns = 1, fontSize = '20px')
})
output$sector_returns_chart <- renderPlotly({
# sector_returns <- tq_get("SECTOR",get = "alphavantager",av_fun = "SECTOR") %>%
# dplyr::mutate(category = str_sub(rank.group,9,str_length(rank.group))) %>%
# dplyr::select(category,sector,value)
filt_return <- sec_rets %>%
filter(category == input$sector_perf_filter) %>%
left_join(sector_color_map, by = "sector") %>%
mutate(value = value/100) %>%
arrange(value) %>%
dplyr::mutate(sector = as_factor(sector))
filt_return %>%
plot_ly(x = ~value,
y = ~sector,
type = 'bar',
orientation = "h",
color = ~sector,
showlegend = F,
colors = adjustcolor(brewer.pal(11,"RdBu"),alpha.f = 0.8)) %>%
layout(xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(type = "category",
title = ""))
})
output$return_stats_one <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_one(ticker,"SPY")
})
output$return_stats_two <- renderText({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
q_return_stats_two(ticker,"SPY")
})
# Performance Chart-----------------------------
output$ret_perf <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
ticks <- c(ticker,"SPY")
# plot -----------------------
plot.df <- q_price(ticks,
start_date = Sys.Date() - years(2),
frequency = "daily")%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = "daily",
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,"Daily Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = ""))
})
output$key_stats <- renderDataTable({
validate(need(!is.null(input$watchlist_dt_rows_selected), "Select a Security to View Key Stats"))
# Yahoooo Key Stats
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- q_key_stats(ticker)
DT::datatable(df,
colnames = c("","","",""),
rownames = FALSE,
selection = 'none', options = list(dom = 't',
bSort=FALSE,
columnDefs = list(
list(className = 'dt-right', targets = c(1,3)))))
})
output$filing_short <- renderDataTable({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
filings <- company_filings(ticker , count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$own_pie <- renderPlotly({
req(input$watchlist_dt_rows_selected)
# s <- ifelse(is.null(input$watchlist_dt_rows_selected),1,input$watchlist_dt_rows_selected)
s <- input$watchlist_dt_rows_selected
ticker <- q_quotes %>%
arrange(desc(pct_chg)) %>%
.[[s,1]]
df <- Quandl.datatable("SHARADAR/SF3", ticker = ticker,
paginate = T, securitytype = "SHR",
calendardate.gte=as.character(Sys.Date()-days(180))) %>%
filter(calendardate == max(calendardate)) %>%
select(-c(ticker,securitytype)) %>%
as_tibble()
all_sh_sum <- sum(df$value)
inst_data <- df %>%
mutate(top_5 = ifelse(min_rank(desc(value))<= 5, investorname,"OTHER")) %>%
group_by(top_5) %>%
summarize(pct_by_group = sum(value,na.rm = T)/all_sh_sum) %>%
mutate(lev = ifelse(top_5 == "Other",dplyr::n()+1,min_rank(desc(pct_by_group)))) %>%
arrange(lev) %>%
mutate(top_5 = factor(top_5,unique(top_5)))
inst_data %>%
plot_ly(labels = ~top_5,
values = ~pct_by_group,
type = 'pie')
})
# Equity Overview Script ----------------------------------------
output$title_1 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Info")
})
output$title_3 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1," Company Description")
})
output$key_info <- renderDataTable({
req(input$ticker_1)
if (is.null(quandl_api_key())){
return(warning("No Quandl API key detected. Limited to 50 anonymous calls per day. Set key with 'quandl_api_key()'.",
call. = FALSE))
}
key_info <- Quandl.datatable("SHARADAR/TICKERS",ticker = input$ticker_1) %>%
filter(table == "SF1") %>%
select(ticker,name,exchange,sicsector,sicindustry,location,secfilings,companysite) %>%
rename(sector = sicsector,
industry = sicindustry) %>%
gather(key,value)
key_info %>%
bind_cols(q_key_stats(input$ticker_1)) %>%
mutate(value = ifelse(key %in% c("secfilings","companysite"),
paste0("<a href='",value,"' target='_blank'>","Link","</a>"),
value)) %>%
mutate(key = str_to_title(key)) %>%
as_tibble() %>%
datatable(rownames = F,
colnames=c("", "","","","",""),
escape = F,
options = list(dom = 't',ordering=F))
})
output$descrip <- renderText({
req(input$ticker_1)
paste0("<h4>",q_descrip(input$ticker_1),"</h4>")
})
# Technical Indicators------------------------------------------------
tech_price <- reactive({
req(input$ticker_1)
req(input$tech_date_range)
tq_get(input$ticker_1, from = input$tech_date_range[[1]] %m-% years(1),
to = input$tech_date_range[[2]])
})
# SMA(x, n = 10, ...)
output$ind_sma <- renderHighchart({
req(input$sma_one)
req(input$sma_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_one, col_rename = "sma_50") %>%
tq_mutate(select = adjusted, mutate_fun = SMA, n = input$sma_two, col_rename = "sma_200") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
sma_one_name <- paste0(input$sma_one," MA")
sma_two_name <- paste0(input$sma_two," MA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$sma_50, yAxis = 0, name = sma_one_name) %>%
hc_add_series(ind_xts$sma_200,yAxis = 0, name = sma_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
# EMA(x, n = 10, wilder = FALSE, ratio = NULL, ...)
output$ind_ema <- renderHighchart({
req(input$ema_one)
req(input$ema_two)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_one,col_rename = "ema_20") %>%
tq_mutate(select = adjusted, mutate_fun = EMA, n = input$ema_two, col_rename = "ema_50") %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
ema_one_name <- paste0(input$ema_one," EMA")
ema_two_name <- paste0(input$ema_two," EMA")
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$ema_20, yAxis = 0, name = ema_one_name) %>%
hc_add_series(ind_xts$ema_50,yAxis = 0, name = ema_two_name) %>%
hc_add_series(ind_xts$volume, color = "gray", yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_macd <- renderHighchart({
req(input$macd_nfast)
req(input$macd_nslow)
req(input$macd_nsig)
# MACD(x, nFast = 12, nSlow = 26, nSig = 9, maType, percent = TRUE, ...)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = MACD,
nFast = input$macd_nfast,
nSlow = input$macd_nslow,
nSig = input$macd_nsig) %>%
mutate(diff = macd - signal) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$macd, color = "blue", yAxis = 1, name = "MACD") %>%
hc_add_series(ind_xts$signal, color = "green", yAxis = 1, name = "Signal") %>%
hc_add_series(ind_xts$diff, color = "gray", yAxis = 1, type = "column", name = "Difference") %>%
hc_tooltip(valueDecimals = "2")
})
# stoch(HLC, nFastK = 14, nFastD = 3, nSlowD = 3, maType, bounded = TRUE, smooth = 1, ...)
# aapl %>% tq_mutate(select = c(high,low,close), mutate_fun = stoch)
output$ind_stoch <- renderHighchart({
req(input$stoch_fastk)
req(input$stoch_fastd)
req(input$stoch_slowd)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = stoch,
nFastK= input$stoch_fastk,
nFastD = input$stoch_fastd,
nSlowD = input$stoch_slowd) %>%
mutate(stoch = stoch *100,
lower_level = 20,
upper_level = 80) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$stoch, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# RSI(price, n=14, maType="WMA", wts=ttrc[,"Volume"])
# aapl %>% tq_mutate(select = adjusted, mutate_fun = RSI)
output$ind_rsi <- renderHighchart({
req(input$rsi_n)
ind_df <- tech_price() %>%
tq_mutate(select = adjusted, mutate_fun = RSI,
n = input$rsi_n) %>%
mutate(lower_level = 30,
upper_level = 70) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$rsi, color = "blue", yAxis = 1, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# CCI(HLC, n = 20, maType, c = 0.015, ...)
output$ind_cci <- renderHighchart({
req(input$cci_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low,close), mutate_fun = CCI,
n = input$cci_n) %>%
mutate(lower_level = -100,
upper_level = 100) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$cci, color = "blue", yAxis = 1, name = "CCI") %>%
hc_add_series(ind_xts$lower_level, color = "green",yAxis = 1, name = "Oversold",
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "red", yAxis = 1, name = "Overbought", tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# aroon(HL, n = 20)
# aapl %>% tq_mutate(select = c(high,low), mutate_fun = aroon)
output$ind_aroon <- renderHighchart({
req(input$aroon_n)
ind_df <- tech_price() %>%
tq_mutate(select = c(high,low), mutate_fun = aroon,
n = input$aroon_n) %>%
filter(date >= input$tech_date_range[[1]]) %>%
mutate(lower_level = -100,
upper_level = 100)
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$aroonUp, color = "green", yAxis = 1, name = "Up") %>%
hc_add_series(ind_xts$aroonDn, color = "red", yAxis = 1, name = "Down" ) %>%
hc_add_series(ind_xts$oscillator, color = "blue", yAxis = 2, name = "Oscillator") %>%
hc_add_series(ind_xts$lower_level, color = "black",yAxis = 2,
tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 2, tooltip = list(pointFormat = "{point.y}"))%>%
hc_tooltip(valueDecimals = "2")
})
# OBV(price, volume)
output$ind_obv <- renderHighchart({
ind_df <- tech_price() %>%
tq_mutate_xy(adjusted,volume, mutate_fun = OBV) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$obv, color = "blue", yAxis = 1, name = "On Balance Volume") %>%
hc_tooltip(valueDecimals = "2")
})
# Need to Join Seperately
# ADX(HLC, n = 14, maType, ...)
output$ind_adx <- renderHighchart({
req(input$adx_n)
ind_df <- tech_price() %>% tq_transmute(select = c(high,low,close), mutate_fun = ADX, n = input$adx_n) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(2,1,1), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$DIp, color = "green", yAxis = 1, name = "Positive") %>%
hc_add_series(ind_xts$DIn, color = "red", yAxis = 1, name = "Negative") %>%
hc_add_series(ind_xts$ADX, color = "black", yAxis = 2, name = "ADX") %>%
hc_add_series(ind_xts$DX, color = "blue", yAxis = 2, name = "DX") %>%
hc_tooltip(valueDecimals = "2")
})
output$ind_bbands <- renderHighchart({
req(input$bbands_n)
req(input$bbands_sd)
# BBands(HLC, n = 20, maType, sd = 2, ...)
ind_df <- tech_price() %>% tq_transmute(select = adjusted,
mutate_fun = BBands,
n= input$bbands_n,
sd= input$bbands_sd) %>%
mutate(date = as.Date(date)) %>%
left_join(tech_price(),by = "date") %>%
select(date,open,high,low,close,volume,adjusted,everything()) %>%
mutate(upper_level = 1,
lower_level = 0) %>%
filter(date >= input$tech_date_range[[1]])
ind_xts <- xts(ind_df[-1],ind_df$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2,2), turnopposite = TRUE)
) %>%
hc_add_series(ind_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(ind_xts$dn, color = "green", yAxis = 0, name = "Lower") %>%
hc_add_series(ind_xts$up, color = "red", yAxis = 0, name = "Upper") %>%
hc_add_series(ind_xts$mavg, color = "black", yAxis = 0, name = "Moving Average") %>%
hc_add_series(ind_xts$pctB, color = "blue", yAxis = 1, name = "% B") %>%
hc_add_series(ind_xts$upper_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_add_series(ind_xts$lower_level, color = "black", yAxis = 1, tooltip = list(pointFormat = "{point.y}")) %>%
hc_tooltip(valueDecimals = "2")
})
# Pricing Data------------------
q_pricing <- reactive({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
tq_get(input$ticker_1,
from = input$price_date_range[[1]],
to = input$price_date_range[[2]])
})
# Pricing Chart------------------------
output$price_chart <- renderHighchart({
price_dt <- q_pricing()
price_xts <- xts(price_dt[-1],price_dt$date)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(2, height = c(2, 1), turnopposite = TRUE)
) %>%
hc_add_series(price_xts, yAxis = 0, name = input$ticker_1) %>%
hc_add_series(price_xts$volume, yAxis = 1, name = "Volume", type = "column") %>%
hc_tooltip(valueDecimals = "2")
})
output$pricing_dt <- renderRHandsontable({
q_pricing() %>%
arrange(desc(date)) %>%
rhandsontable(stretchH = "all")
})
output$div_plot <- renderPlotly({
req(input$ticker_1)
divs <- tq_get(input$ticker_1,
get = "dividends")
if("dividends" %in% colnames(divs)){
divs %>%
plot_ly(x = ~date,
y = ~dividends,
type = 'scatter',
mode = 'lines',
fill = 'tozeroy') %>%
layout(title = paste0(input$ticker_1," Dividends Over Time"),
plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
}
})
# Returns Data -----------------------------------
output$returns_dt <- renderText({
req(input$ticker_1)
req(input$returns_benchmark)
ticker <- as.character(input$ticker_1)
benchmark <- as.character(input$returns_benchmark)
q_return_stats_full(ticker,
benchmark,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]])
})
# Performance Chart-----------------------------
output$performance_chart <- renderPlotly({
req(input$ticker_1)
req(input$returns_benchmark)
ticks <- c(input$ticker_1,input$returns_benchmark)
# plot -----------------------
plot.df <- q_price(ticks,
start_date = input$returns_date_range[[1]],
end_date = input$returns_date_range[[2]],
frequency = input$returns_freq)%>%
select(q_ticker,date,adjClose) %>%
group_by(q_ticker) %>%
tq_mutate(select = adjClose,
mutate_fun = periodReturn,
period = input$returns_freq,
col_rename = "return") %>%
select(q_ticker,date,adjClose,return) %>%
group_by(q_ticker) %>%
mutate(cum.ret = with_order(date,cumprod,1+return),
cum.max = with_order(date,cummax,cum.ret),
DD = cum.ret/cum.max - 1,
cum.ret = cum.ret-1) %>%
ungroup()
perf.c<-
plot.df %>%
plot_ly(x = ~date,
y = ~cum.ret,
color = ~q_ticker,
type = "scatter",
mode = "lines",
name = ~paste(q_ticker,"Total Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(x = ~date,
y = ~return,
color = ~q_ticker,
type = "bar",
name = ~paste(q_ticker,input$returns_freq," Return")) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(x = ~date,
y = ~DD,
color = ~q_ticker,
type ="scatter",
mode = "lines",
name = ~paste(q_ticker,"Drawdown")) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = "")) %>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
# Key Returns --------------------
output$key_returns <- renderDataTable({
req(input$ticker_1)
req(input$returns_benchmark)
tick_key_rets <- q_key_returns(input$ticker_1)
bench_key_rets <- q_key_returns(input$returns_benchmark)
tick_key_rets %>%
full_join(bench_key_rets) %>%
DT::datatable(rownames=F,options = list(dom = "t")) %>%
formatPercentage(2:11)
})
# Calendar Returns------------------
output$calendar_returns <- renderDataTable({
req(input$ticker_1)
cal_returns<- q_return(input$ticker_1,frequency = "monthly")
nms <- tibble(
mnth_abbrev = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
mnth = c(1,2,3,4,5,6,7,8,9,10,11,12))
cal_returns %>%
select(date,monthly_return) %>%
mutate(mnth = month(date),
year = year(date)) %>%
left_join(nms,by = "mnth") %>%
select(-date,-mnth) %>%
spread(mnth_abbrev,monthly_return) %>%
select(year,nms$mnth_abbrev) %>%
arrange(desc(year)) %>%
DT::datatable(rownames=F, options = list(dom = 'tp')) %>%
formatPercentage(nms$mnth_abbrev,1)
})
company_news <-reactive({
req(input$ticker_1)
q_news(input$ticker_1,
sources = input$news_sources)
})
output$ticker_comps_tbl <- renderRHandsontable({
req(input$ticker_1)
comps <- q_comps(input$ticker_1)
# row_highlight <- comps %>%
# mutate(row_n = row_number()) %>%
# filter(str_detect(ticker,input$ticker_1)) %>%
# pull(row_n)
#
# row_highlight = 4
comps %>%
rhandsontable()
})
output$news_bub <- renderBubbles({
company_news <- company_news()
company_news %>%
select(tickers) %>%
unnest() %>%
count(tickers) %>%
filter(tickers != str_to_lower(input$ticker_1)) %>%
mutate(tickers = str_to_upper(tickers)) %>%
arrange(desc(n)) %>%
slice(1:5) %>%
mutate(color = rep_len(tol12qualitative,5)) %>%
bubbles::bubbles(value = .$n,
label = .$tickers,
tooltip = .$n,
color = .$color,
textColor = "white")
# mutate(color = rep_len(brewer.pal(8,"Dark2"),15)) %>%
# bubbles::bubbles(value = .$n,label = .$tickers,
# color = .$color)
})
output$news_cloud <- renderWordcloud2({
req(input$ticker_1)
company_news <- company_news()
company_descrip <- company_news %>%
pull(description)
descrip_df <- tibble(line = 1:length(company_descrip), text = company_descrip)
text_count <- descrip_df %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
sent <- text_count %>%
inner_join(get_sentiments(input$news_lex)) %>%
count(word) %>%
rename(freq = n)
descrip_df <- descrip_df %>%
unnest_tokens(word,text) %>%
count(word) %>%
anti_join(stop_words) %>%
arrange(desc(n)) %>%
rename(freq = n)
if(input$sent_filt){
# Wordcloud
sent %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
} else{
descrip_df %>%
wordcloud2(backgroundColor = 'rgb(236,240,245)',size = 1.3)
}
})
# News DT--------------------
output$news_dtt <- DT::renderDataTable({
req(input$ticker_1)
company_news <- company_news()
company_news <- company_news %>%
dplyr::select(title,description,source,published_date,url) %>%
mutate(title = paste0("<a href='",url,"' target='_blank'>",title,"</a>"),
source = paste0("<a href='","https://",source,"' target='_blank'>",str_replace(source,pattern = ".com",""),"</a>")) %>%
dplyr::select(-url)
dt <- company_news %>%
DT::datatable(rownames = F,selection = 'single',
escape = F,
class = 'cell-border stripe',
options = list(
columnDefs = list(
list(width = '300px', targets = c(0,1)),
list(width = '100px', targets = c(2,3)),
list(height = '100px', targets = "_all"),
list(className = 'dt-center',targets = c(2,3)),
list(className = 'dt-right',targets = 0))))
dt %>% formatDate(4,'toUTCString') %>%
DT::formatStyle(columns = 1, fontSize = '20px')
})
text_df <- reactive({
req(input$ticker_1)
t_script <- q_transcript(input$ticker_1)
t_ext <- t_script %>%
slice(1) %>%
pull(link) %>%
read_html() %>%
html_nodes("p") %>%
html_text()
data_frame(line = 1:length(t_ext), text = t_ext)
})
sent <- reactive({
text_count <- text_df() %>%
unnest_tokens(word,text) %>%
anti_join(stop_words)
text_count %>%
inner_join(get_sentiments("loughran"))
})
output$word_cloud <- renderWordcloud2({
# sent() %>%
# count(word, sentiment, sort = TRUE) %>%
# acast(word ~ sentiment, value.var = "n", fill = 0) %>%
# comparison.cloud(colors=rev(brewer.pal(3,"Dark2")[1:2]),
# max.words = 50)
sent() %>% count(word) %>% rename(freq = n) %>% wordcloud2(size=1.3,
backgroundColor = 'rgb(236,240,245)')
})
output$sent_chart <- renderPlotly({
gg <- sent() %>%
filter(sentiment != "superfluous", sentiment != "constraining") %>%
filter(!str_detect(word,"question")) %>%
count(word,sentiment,sort = T) %>%
group_by(sentiment) %>%
slice(1:5) %>%
ungroup() %>%
# mutate(n = ifelse(sentiment=="negative",-n,n)) %>%
mutate(word = str_to_title(word)) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free") +
labs(y = NULL,
x = NULL) +
coord_flip()+
theme_minimal()
# Sentiment Plotly
ggplotly(gg)%>%
layout(plot_bgcolor='rgb(236,240,245)') %>%
layout(paper_bgcolor='rgb(236,240,245)')
})
output$some_text <- renderText({
if(!is.null(input$search) & input$search != ""){
text_df <- text_df() %>%
filter(str_detect(text,input$search)) %>%
mutate(text = str_replace_all(text,input$search,paste0("<mark>",input$search,"</mark>")))
t_script <- paste(text_df$text,collapse="<br><br>")
} else {
text_df <- text_df()
t_script <- paste(text_df$text,collapse="<br><br>")
}
paste0("<h4>",t_script,"</h4>")
})
output$ten_k_q_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$ten_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "10-",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$eight_k_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$eight_k_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "8-K",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$prospectus_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$pros_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "424B2",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$proxy_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$proxy_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "DEF 14A",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
output$thirteen_table <- renderDataTable({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings$type <- paste0("<a href='",filings$href,"' target='_blank'>",filings$type,"</a>")
filings %>%
as_tibble() %>%
mutate(filing_date = as.Date(filing_date)) %>%
select(filing_date,
type,
form_name) %>%
DT::datatable(rownames = F,
escape = F)
})
output$thirteen_plot <- renderPlotly({
req(input$ticker_1)
filings <- company_filings(input$ticker_1, type = "SC 13",count = 100)
filings %>%
as_tibble() %>%
select(filing_date,type,form_name) %>%
filter(filing_date >= Sys.Date()%m-% years(5)) %>%
mutate(filing_date = as.Date(filing_date)) %>%
vistime(start = "filing_date",
end = "filing_date",
events = "type",
groups = "type") %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
})
}))
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.