old_ref/quant_viz_old_ref.R
In zac-garland/equityresearch: Equity Research in R
# Header ------------------------------------------------
header <-
dashboardHeader(title = shiny::tags$a(
shiny::tags$img(
src = "logo_r_equity_research_14.svg",
width = "200",
height = "31"
)
))
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(
sidebarSearchForm(
textId = "ticker_1",
buttonId = "searchButton",
label = "Ticker..."
),
sidebarMenu(
id = 'sidebarmenu',
menuItem(
'About Me',
tabName = 'me_overview',
icon = icon('id-card'),
menuSubItem("About Me",
tabName = "about_me")
),
# 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"
)
)
),
# Fundamental Indicators-----------------
menuItem(
'Fundamental Indicators',
tabName = 'fund_indicators',
icon = icon('industry'),
textInput(inputId = "compare_ticker",
"Comparison Ticker",
value = NULL),
menuItem(
"Value",
tabName = "value_ratios",
menuSubItem("Earnings Yield", "tab_earnings_yield"),
menuSubItem("Dividend Yield", "tab_dividend_yield"),
menuSubItem("Book Yield", "tab_book_to_price"),
menuSubItem("Operating CF Yield", "tab_ocf_yield"),
menuSubItem("Free Cash Flow Yield", "tab_fcf_yield"),
menuSubItem("Sales to Price", "tab_sales_to_price")
),
menuItem(
"Efficiency",
tabName = "eff_ratios",
menuSubItem("Inventory Turnover", "tab_inv_turn"),
menuSubItem("Receivables Turnover", "tab_rec_turn"),
menuSubItem("Asset Turnover", "tab_asset_turnover")
),
menuItem(
"Solvency",
tabName = "solve_ratios",
menuSubItem("Current Ratio", "tab_curr_ratio"),
menuSubItem("Cash Ratio", "tab_cash_ratio"),
menuSubItem("Debt to Assets", "tab_debt_to_assets"),
menuSubItem("Debt to Equity", "tab_debt_to_equity"),
menuSubItem("Debt to Capital", "tab_debt_to_capital")
),
menuItem(
"Profitability",
tabName = "profit_ratios",
menuSubItem("Gross Margin", "tab_gross_mgn"),
menuSubItem("Operating Margin", "tab_oper_mgn"),
menuSubItem("Profit Margin", "tab_profit_mgn"),
menuSubItem("Return on Assets", "tab_return_on_assets"),
menuSubItem("Return on Equity", "tab_return_on_equity")
)
),
# Fundamental Overview -------------------------
menuItem(
'Fundamental Data',
tabName = 'fundamental_data',
icon = icon('book'),
selectInput(
"fund_dim",
"Data Type",
c("As Reported" = "AR",
"Restated" = "MR"),
"AR"
),
selectInput(
"fund_freq",
"Frequency:",
c(
"Annual" = "Y",
"Quarterly" = "Q",
"Trailing Twelve Months" = "T"
),
"Y"
),
# Income Statement -------------------------
menuSubItem('Income Statement',
tabName = 'income_statement'),
# # Balance Sheet-----------------------
menuSubItem('Balance Sheet',
tabName = 'balance_sheet'),
# Cash Flow Statement------------------
menuSubItem('Cash Flow Statement',
tabName = 'cash_flow_statement'),
conditionalPanel(
"input.sidebarmenu === 'cash_flow_statement'",
selectizeInput(
inputId = 'cf_item',
label = "Graph Line Item:",
choices = c(
"Net Income" = "q_net_inc",
"Capital Expenditures" = "q_capex",
"CF - Business Acquisitions" = "q_cf_biz_acq",
"Investments" = "q_investments",
"Financing Cash Flow" = "q_cf_fin",
"Debt Issue" = "q_debt_issue",
"Equity Issue" = "q_equity_issue",
"Cash Distribution" = "q_cash_distr",
"Investing Cash Flow" = "q_cf_inv",
"Operating Cash Flow" = "q_cf_oper",
"Change In Cash" = "q_cf_cash",
"Share Compensation" = "q_share_comp",
"Depreciation & Amortization" = "q_depr_amort"
),
multiple = TRUE,
c("q_cf_fin", "q_cf_oper", "q_cf_inv")
)
)
),
# 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")
),
# 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"
)
)
),
# Ownership---------------------------
menuItem(
'Ownership',
tabName = 'ownership',
icon = icon('users'),
menuSubItem("Institutional Ownership", "ownership"),
conditionalPanel(
"input.sidebarmenu === 'ownership'",
uiOutput("inst_date_filter")
)
),
# Screening-----------------------------
menuItem(
'Screening',
tabName = 'screening',
icon = icon('filter'),
selectizeInput(
"index_id",
"Universe:",
choices = ishs_choices,
selected = "ITOT"
),
menuSubItem("Index Constits",
"constits"),
menuSubItem("Screening",
"screen"),
menuSubItem("Cluster Risk",
tabName = "hc"),
conditionalPanel(
"input.sidebarmenu === 'screen'",
numericInput(
"screen_cut",
"Cut:",
value = .05,
min = 0,
max = 1,
step = .01
)
),
conditionalPanel(
"input.sidebarmenu === 'hc'",
sliderInput(
"clust_date",
"Correlation Date Range:",
min = min(ret$date, na.rm =
T),
max = max(ret$date, na.rm = T),
value = max(ret$date, na.rm =
T),
step = months(3),
dragRange = T
),
sliderInput(
"clust_cut",
"# of Clusters",
min = 25,
max = 1000,
value = 700,
step = 50
),
numericInput("clust_rank",
"Cluster Rank:",
value = 1),
textInput("clust_tick",
"Ticker Filter:",
value = NULL),
checkboxInput("predict_rets",
"Forward Returns",
value = F)
)
)
)
)
# 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(
about_me,
tabItem(
tabName = "watchlist",
fluidRow(column(
6,
tabBox(
id = "tabset_watch",
height = "550px",
width = 12,
tabPanel("Watchlist",
withSpinner(dataTableOutput("watchlist_dt"))),
tabPanel("Short Port",
withSpinner(dataTableOutput("short_port_dt"))),
tabPanel("Sectors",
br(),
br(),
withSpinner(plotlyOutput(
"sector_returns_chart"
)))
)
),
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("Relative Perf",
withSpinner(plotlyOutput("ret_perf"))),
tabPanel("Key Stats",
br(),
br(),
withSpinner(dataTableOutput("key_stats")))
)
)),
fluidRow(column(
6,
tabBox(
id = "small_eq_fin",
height = "750px",
width = 12,
tabPanel("Income",
withSpinner(htmlOutput("sm_eq_inc_dt"))),
tabPanel("Assets",
withSpinner(htmlOutput("sm_eq_assets_dt"))),
tabPanel("Liabilities",
withSpinner(htmlOutput("sm_eq_liab_dt"))),
tabPanel("Equity",
withSpinner(htmlOutput("sm_eq_equity_dt"))),
tabPanel("Cash Flow",
withSpinner(htmlOutput("sm_eq_cf_dt")))
)
),
column(
6,
tabBox(
id = "watchlist_4",
height = "750px",
width = 12,
tabPanel("Filings",
withSpinner(dataTableOutput("filing_short"))),
tabPanel("Ownership",
br(),
br(),
withSpinner(plotlyOutput("own_pie")))
)
))
),
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")))
),
# Income Statement ----------------------------------
tabItem(tabName = "income_statement",
fluidRow(column(
12,
withSpinner(plotlyOutput(outputId = "waterfall_chart"))
)),
fluidRow(column(
12,
htmlOutput("income_statement_dt")
))),
# Balance Sheet ----------------------------------
tabItem(tabName = "balance_sheet",
# Creating Columns and Rows ------------------------------------
fluidRow(column(
12,
withSpinner(highchartOutput(outputId = "balance_sheet_treemap"))
)),
fluidRow(
tabBox(
id = "tabset_3",
height = "600px",
width = 12,
tabPanel("Assets",
htmlOutput("assets_dt")),
tabPanel("Liabilities",
htmlOutput("liab_dt")),
tabPanel("Equity",
htmlOutput("equity_dt"))
)
)),
# Cash Flow Statement ----------------------------------
tabItem(tabName = "cash_flow_statement",
fluidRow(column(
12, withSpinner(plotlyOutput("cf_graph"))
)),
# Creating Columns and Rows ------------------------------------
fluidRow(column(
12, htmlOutput("cf_dt")
))),
# Fundamental Indicators------------------
# Value Ratios-------------------
full_page("tab_earnings_yield",
withSpinner(
highchartOutput("earnings_yield", height = "750px")
)),
full_page("tab_dividend_yield",
withSpinner(
highchartOutput("div_yield", height = "750px")
)),
full_page("tab_book_to_price",
withSpinner(
highchartOutput("book_yield", height = "750px")
)),
full_page("tab_ocf_yield",
withSpinner(
highchartOutput("ocf_yield", height = "750px")
)),
full_page("tab_fcf_yield",
withSpinner(
highchartOutput("fcf_yield", height = "750px")
)),
full_page("tab_sales_to_price",
withSpinner(
highchartOutput("sales_yield", height = "750px")
)),
# Efficiency Ratios------------------
full_page("tab_inv_turn",
withSpinner(
highchartOutput("inv_turn", height = "750px")
)),
full_page("tab_rec_turn",
withSpinner(
highchartOutput("rec_turn", height = "750px")
)),
full_page("tab_asset_turnover",
withSpinner(
highchartOutput("asset_turn", height = "750px")
)),
#Solvency Ratios -----------------
full_page("tab_curr_ratio",
withSpinner(
highchartOutput("curr_ratio", height = "750px")
)),
full_page("tab_cash_ratio",
withSpinner(
highchartOutput("cash_ratio", height = "750px")
)),
full_page("tab_debt_to_assets",
withSpinner(
highchartOutput("debt_to_assets", height = "750px")
)),
full_page("tab_debt_to_equity",
withSpinner(
highchartOutput("debt_to_equity", height = "750px")
)),
full_page("tab_debt_to_capital",
withSpinner(
highchartOutput("debt_to_capital", height = "750px")
)),
# Profitability Ratios---------------
full_page("tab_gross_mgn",
withSpinner(
highchartOutput("gross_margin", height = "750px")
)),
full_page("tab_oper_mgn",
withSpinner(
highchartOutput("operating_margin", height = "750px")
)),
full_page("tab_profit_mgn",
withSpinner(
highchartOutput("profit_margin", height = "750px")
)),
full_page("tab_return_on_assets",
withSpinner(
highchartOutput("return_on_assets", height = "750px")
)),
full_page("tab_return_on_equity",
withSpinner(
highchartOutput("return_on_equity", height = "750px")
)),
# 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")
)))
)
#
# fluidRow(column(12,withSpinner(rHandsontableOutput("cor_mx", height ="900px")))),
#
# # full_row(rHandsontableOutput("cor_mx")),
# full_row(plotlyOutput("ret_filt"))
)
)
)
# APP ------------------------------------------------
shinyApp(
ui <- dashboardPage(title = "Equity Research",
header,
sidebar,
body,
skin = "black"),
# Server ----------------------------------------------------------
shinyServer(function(input, output) {
# Watchlist Script------------------------------------------------
output$polar_chart <- renderPlotly({
plot_ly(type = 'scatterpolar',
fill = 'toself') %>%
add_trace(
r = c(25, 25, 25, 0, 0, 0),
theta = c(
"Consulting",
"Education",
"Analyst",
"Asset Management",
"Coding",
"Data Science"
),
name = 'Experience',
fillcolor = 'rgba(55, 128, 191, 0.5)',
marker = list(color = "black")
) %>%
add_trace(
r = c(0, 0, 25, 25, 25, 25),
theta = c(
"Consulting",
"Education",
"Analyst",
"Asset Management",
"Coding",
"Data Science"
),
name = 'Capstone',
fillcolor = 'rgba(50, 171, 96, 0.5)',
marker = list(color = "black")
) %>%
layout(
polar = list(radialaxis = list(
visible = T,
range = c(0, 50)
)),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)'
)
})
output$ideal_map <- renderHighchart({
ideal_location()
})
output$invest_style <- renderPlotly({
my_style %>%
# group_by(category) %>%
arrange(desc(value)) %>%
mutate(name = as_factor(name)) %>%
# mutate(row_n = 1:nrow(.)) %>% arrange(desc(row_n)) %>%
# arrange(order) %>%
# mutate(category = fct_reorder(category,order)) %>%
plot_ly(
x = ~ value,
y = ~ category,
# sort = F,
type = "bar",
color = ~ value,
colors = 'Blues',
# marker = list(color = ~color),
orientation = "h",
name = ~ name
) %>%
layout(
yaxis = list(title = ''),
xaxis = list(title = ''),
barmode = 'stack'
) %>%
hide_colorbar() %>%
layout(
legend = list(orientation = 'h', y = -0.1),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)'
)
})
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$short_port_dt <- renderDataTable({
short_port <- read_csv(q_trash("short_port"))
# Daily Performance------------------------------------
short_q <- short_port %>%
pull(ticker) %>%
map_df(q_quote)
short_q %>%
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$sm_eq_inc_dt <- renderText({
validate(need(
!is.null(input$watchlist_dt_rows_selected),
"Select a Security to View Financials"
))
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_inc_fmt_tbl(ticker, n = 3)
})
# Assets Sub Plot---------------------------------------------
output$sm_eq_assets_dt <- 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_bal_fmt_tbl(ticker, n = 3)
})
output$sm_eq_liab_dt <- 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_bal_fmt_tbl(ticker,
selection = "liab",
n = 3)
})
output$sm_eq_equity_dt <- 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_bal_fmt_tbl(ticker,
selection = "equity",
n = 3)
})
output$sm_eq_cf_dt <- 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_cf_fmt_tbl(ticker,
n = 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_2 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1, " Frequently Mentioned With")
})
output$title_3 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1, " Company Description")
})
output$title_4 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1, " Frequent News Buzzwords")
})
output$key_info <- renderDataTable({
req(input$ticker_1)
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>")
# descrip <- descrip %>%
# str_split(" ") %>%
# as_vector() %>%
# tibble(word = .) %>%
# mutate(word = ifelse(!(word %in% stop_words$word),
# paste0("<b>",word,"</b>"),
# paste0('<font color = "#ECF0F5">',word,"</font>"))) %>%
# pull(word) %>%
# paste(sep = " ",collapse = " ")
#
# paste0("<h4>",descrip,"</h4>")
# %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# inner_join(sentiments) %>%
# distinct(word) %>%
# mutate(word = paste(word,"<br>")) %>%
# pull()
# descrip %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# pull(word) %>%
# paste(sep = "",collapse = "")
# as.vector(strsplit(descrip, '\\. ')) %>%
# tibble(word = .) %>%
# unnest(word) %>%
# mutate(line = 1:nrow(.)) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# nest(word) %>%
# mutate(text = map(data,unlist),
# text = map_chr(text, paste, collapse = " "),
# text = paste(text,"<br>")) %>%
# pull(text)
})
# IS Waterfall Chart---------------------------------------------
output$waterfall_chart <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
df <-
q_income_statement(ticker, dimension = paste0(input$fund_dim, input$fund_freq))
df <- df[1, ]
dat_graph <-
tibble(
x = c(
'Revenue',
'COGS',
'Gross Margin',
'Op Ex',
'RND',
'SGA',
'Op Income',
'Other Inc',
'EBIT',
'Interest and Taxes',
'Net Income'
),
base = c(
0,
df$q_gross_profit,
0,
df$q_oper_inc,
(df$q_gross_profit - df$q_rnd),
df$q_oper_inc,
0,
ifelse(
df$q_other_income > 0,
df$q_oper_inc,
df$q_oper_inc + df$q_other_income
),
0,
ifelse(
df$q_interest_nd_tax > 0,
df$q_ebit,
df$q_ebit + df$q_interest_nd_tax
),
0
),
revenues = c(
df$q_revenue,
rep(0, 6),
ifelse(df$q_other_income > 0 , df$q_other_income, 0),
0,
ifelse(df$q_interest_nd_tax > 0, df$q_interest_nd_tax, 0),
0
),
costs = c(
0,
df$q_cogs,
0,
df$q_oper_exp,
df$q_rnd,
df$q_sgna,
0,
ifelse(df$q_other_income < 0 ,-df$q_other_income, 0),
0,
ifelse(df$q_interest_nd_tax < 0,-df$q_interest_nd_tax, 0),
0
),
profit = c(
0,
0,
df$q_gross_profit,
rep(0, 3),
df$q_oper_inc,
0,
df$q_ebit,
0,
df$q_net_inc
)
)
dat_graph <- dat_graph %>%
filter(!(x %in% c("RND", "SGA"))) %>%
mutate(y = ifelse(
costs == 0,
sum(base, revenues, costs, profit) / 2,
base + (costs / 2)
))
#The default order will be alphabetized unless specified as below:
dat_graph$x <- factor(dat_graph$x, levels = dat_graph[["x"]])
plot_ly(
dat_graph,
x = ~ x,
y = ~ base,
type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)')
) %>%
add_trace(
y = ~ revenues,
marker = list(
color = 'rgba(55, 128, 191, 0.7)',
line = list(color = 'rgba(55, 128, 191, 0.7)',
width = 2)
)
) %>%
add_trace(
y = ~ costs,
marker = list(
color = 'rgba(219, 64, 82, 0.7)',
line = list(color = 'rgba(219, 64, 82, 1.0)',
width = 2)
)
) %>%
add_trace(
y = ~ profit,
marker = list(
color = 'rgba(50, 171, 96, 0.7)',
line = list(color = 'rgba(50, 171, 96, 1.0)',
width = 2)
)
) %>%
layout(
title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)',
showlegend = FALSE
)
})
# Income Statement DataTable--------------------------------------------------
output$income_statement_dt <- renderText({
req(input$ticker_1)
q_inc_fmt_tbl(
ticker = input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq)
)
})
# BS Treemap--------------------------------------------------
output$balance_sheet_treemap <- renderHighchart({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
bal_sheet <-
q_balance_sheet(ticker, dimension = paste0(input$fund_dim, input$fund_freq)) %>%
dplyr::select(
q_cal_date,
q_cash,
q_invest_curr,
q_receivables,
q_inventory,
q_other_curr_assets,
q_invest_non_curr,
q_ppe,
q_assets_good_intang,
q_other_non_curr_assets,
q_payables,
q_debt_curr,
q_other_curr_liab,
q_debt_non_curr,
q_other_non_curr_liab,
q_retained_earn,
q_other_equity
)
# Generate Data for Treemap ---------------------
tm <- bal_sheet %>%
dplyr::filter(q_cal_date == max(q_cal_date, na.rm = T)) %>%
gather(q_lo, value,-q_cal_date) %>%
left_join(bal_sheet_tree_ref, by = "q_lo") %>%
rename(descrip = name) %>%
mutate_at("main_group", str_replace, "Equity", "Shareholders Equity") %>%
mutate(color_numeric = as.numeric(as.factor(main_group)))
# Generate Data Classes Colors------------------------------------------
data_classes <- list(
list(
from = 1,
to = 1,
color = "#3780bf",
name = "Assets"
),
list(
from = 2,
to = 2,
color = "#db4052",
name = "Liabilities"
),
list(
from = 3,
to = 3,
color = "#32ab60",
name = "Shareholders Equity"
)
)
hctreemap2(
tm,
group_vars = c("main_group", "sub_group", "descrip"),
size_var = "value",
color_var = "color_numeric",
layoutAlgorithm = "squarified"
) %>%
hc_colorAxis(dataClassColor = "category",
dataClasses = data_classes)
})
# Balance Sheet Data Tables ----------------------------
output$assets_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq))
})
output$liab_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(
input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq),
selection = "liab"
)
})
output$equity_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(
input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq),
selection = "equity"
)
})
# CF Graph ---------------------------------------
output$cf_graph <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
cf_statement <-
q_cash_flow_statement(ticker, dimension = paste0(input$fund_dim, input$fund_freq)) %>%
slice(1:10)
if (!is.null(input$cf_item)) {
cf_statement %>%
select(q_cal_date, input$cf_item) %>%
gather(indicator, value, -q_cal_date) %>%
plot_ly(
x = ~ q_cal_date,
y = ~ value,
color = ~ indicator,
type = "bar"
) %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
}
})
# CF Data Tables----------------------------------------
output$cf_dt <- renderText({
req(input$ticker_1)
q_cf_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq))
})
# Fundamental Indicators--------------------------------
ticker_price <- reactive({
req(input$ticker_1)
# req(input$compare_ticker)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
ticker_price <- tq_get(ticker)
if (!("symbol" %in% colnames(ticker_price))) {
ticker_price <- ticker_price %>% mutate(symbol = input$ticker_1)
}
ticker_price <- ticker_price %>%
select(symbol, date, adjusted) %>%
spread(symbol, adjusted)
ticker_price <-
seq.Date(min(ticker_price$date), max(ticker_price$date), by = "days") %>%
tibble(date = .) %>%
left_join(ticker_price, by = "date") %>%
fill(-date) %>%
gather(symbol, adjusted, -date)
ticker_price
})
# Earnings Yield
output$earnings_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_eps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(earnings_yield = q_eps / adjusted) %>%
select(-c(q_eps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = earnings_yield,
group = q_ticker)) %>%
hc_title(text = "Earnings Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Dividend Yield div/price
output$div_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_divs_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(dividend_yield = q_divs_ps / adjusted) %>%
select(-c(q_divs_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = dividend_yield,
group = q_ticker)) %>%
hc_title(text = "Dividend Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Book Value PS/ Price
output$book_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_bv_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(book_yield = q_bv_ps / adjusted) %>%
select(-c(q_bv_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = book_yield,
group = q_ticker)) %>%
hc_title(text = "Book to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Operating CF Yield OCF PS/Price
output$ocf_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cf_oper", "q_shares"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(oper_cf_yield = (q_cf_oper / q_shares) / adjusted) %>%
select(-c(q_cf_oper, q_shares, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = oper_cf_yield,
group = q_ticker)) %>%
hc_title(text = "Operating Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# FCF Yield PS / Price
output$fcf_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_fcf_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(fcf_yield = q_fcf_ps / adjusted) %>%
select(-c(q_fcf_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = fcf_yield,
group = q_ticker)) %>%
hc_title(text = "Free Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Sales PS / Price
output$sales_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_sales_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(sales_yield = q_sales_ps / adjusted) %>%
select(-c(q_sales_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = sales_yield,
group = q_ticker)) %>%
hc_title(text = "Sales to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Inventory Turnover
output$inv_turn <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cogs", "q_inventory"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(inventory_turnover = q_cogs / q_inventory) %>%
select(-c(q_cogs, q_inventory))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = inventory_turnover,
group = q_ticker)) %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
)) %>%
hc_title(text = "Inventory Turnover")
})
# Recievables Turnover
output$rec_turn <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue", "q_receivables"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(receivables_turnover = q_revenue / q_receivables) %>%
select(-c(q_revenue, q_receivables))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = receivables_turnover,
group = q_ticker)) %>%
hc_title(text = "Receivables Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Asset Turnover
output$asset_turn <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue", "q_assets"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(asset_turnover = q_revenue / q_assets) %>%
select(-c(q_revenue, q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = asset_turnover,
group = q_ticker)) %>%
hc_title(text = "Asset Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Current Ratio
output$curr_ratio <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_assets_curr", "q_liab_curr"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(current_ratio = q_assets_curr / q_liab_curr) %>%
select(-c(q_assets_curr, q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = current_ratio,
group = q_ticker)) %>%
hc_title(text = "Current Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Cash Ratio
output$cash_ratio <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cash", "q_investments", "q_receivables", "q_liab_curr"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(cash_ratio = (q_cash + q_investments + q_receivables) / q_liab_curr) %>%
select(-c(q_cash, q_investments, q_receivables, q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = cash_ratio,
group = q_ticker)) %>%
hc_title(text = "Cash Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Debt to Assets
output$debt_to_assets <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt", "q_assets"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(debt_to_assets = q_debt / q_assets) %>%
select(-c(q_debt, q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_assets,
group = q_ticker)) %>%
hc_title(text = "Debt to Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Debt to Capital
output$debt_to_capital <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt", "q_equity"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(debt_to_capital = q_debt / (q_debt + q_equity)) %>%
select(-c(q_debt, q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_capital,
group = q_ticker)) %>%
hc_title(text = "Debt to Capital") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Debt to Equity
output$debt_to_equity <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt", "q_equity"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(debt_to_equity = q_debt / q_equity) %>%
select(-c(q_debt, q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_equity,
group = q_ticker)) %>%
hc_title(text = "Debt to Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Profitability Ratios
# Gross Profit Margin
output$gross_margin <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_gross_profit", "q_revenue")
) %>%
mutate(gross_margin = q_gross_profit / q_revenue) %>%
select(-c(q_gross_profit, q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = gross_margin,
group = q_ticker)) %>%
hc_title(text = "Gross Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Operating Profit Margin
output$operating_margin <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_oper_inc", "q_revenue"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(operating_margin = q_oper_inc / q_revenue) %>%
select(-c(q_oper_inc, q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = operating_margin,
group = q_ticker)) %>%
hc_title(text = "Operating Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Net Profit Margin
output$profit_margin <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc", "q_revenue"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(profit_margin = q_net_inc / q_revenue) %>%
select(-c(q_net_inc, q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = profit_margin,
group = q_ticker)) %>%
hc_title(text = "Profit Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# ROA
output$return_on_assets <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc", "q_assets"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(return_on_assets = q_net_inc / q_assets) %>%
select(-c(q_net_inc, q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_assets,
group = q_ticker)) %>%
hc_title(text = "Return on Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# ROE
output$return_on_equity <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc", "q_equity"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(return_on_equity = q_net_inc / q_equity) %>%
select(-c(q_net_inc, q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_equity,
group = q_ticker)) %>%
hc_title(text = "Return on Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# 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]]
)
# df <- q_price(ticker,
# start_date = input$price_date_range[[1]],
# end_date = input$price_date_range[[2]],
# frequency = input$price_freq) %>%
# select(q_ticker,
# date,
# adjOpen,
# adjLow,
# adjHigh,
# adjClose,
# adjVolume,
# divCash,
# splitFactor)
#
# df
})
# 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')
})
# tr_script <- reactive({
# q_transcript(input$ticker_1)
#
#
# })
#
#
#
# # Filings ---------------------------------
# output$transcript <- renderDataTable({
# library(rebus)
# req(input$ticker_1)
#
#
# tp <- tr_script() %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title)
#
# tp %>%
# DT::datatable(escape = F, rownames = F,
# options = list(pageLength = 20,
# columnDefs = list(list(className = 'dt-center',targets = "_all"))))
#
#
# })
# output$tr_df <- renderDataTable({
#
# library(rebus)
# t <- t_script
#
# t <- t %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title) %>% datatable(escape = F)
#
# t
#
# })
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_y") +
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)')
})
# Ownership -----------------------------
output$inst_date_filter <- renderUI({
req(input$ticker_1)
d_dates <- Quandl.datatable(
"SHARADAR/SF1",
ticker = input$ticker_1,
dimension = "ARQ",
qopts.columns = "calendardate"
) %>%
dplyr::filter(calendardate >= as.Date("2012-12-30"))
selected_date <-
d_dates %>% arrange(desc(calendardate)) %>% filter(1:nrow(.) == 2) %>% pull()
# selected_date <- last_day(Sys.Date())
selectInput(
inputId = "inst_data_date",
label = "Select Calendar Date",
choices = d_dates$calendardate,
selected = selected_date
)
})
inst_data <- reactive({
req(input$ticker_1)
req(input$inst_data_date)
df <- Quandl.datatable(
"SHARADAR/SF3",
ticker = input$ticker_1,
paginate = T,
securitytype = "SHR",
calendardate = input$inst_data_date
) %>%
select(-c(ticker, securitytype)) %>%
as_tibble()
df
})
inst_click <- reactiveValues(multi_click = NULL)
observeEvent(input$inst_own_dt_rows_selected,
{
inst_click$multi_click <- input$inst_own_dt_rows_selected
})
output$top_5_pie <- renderPlotly({
req(input$inst_data_date)
all_sh_sum <- sum(inst_data()$value)
if (!is.null(inst_click$multi_click)) {
inst_data <- inst_data() %>%
mutate(top_5 = ifelse(
1:nrow(.) %in% input$inst_own_dt_rows_selected,
investorname,
"Other"
)) %>%
group_by(top_5) %>%
summarize(pct_by_group = sum(value, na.rm = T) / all_sh_sum)
} else {
inst_data <- inst_data() %>%
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)
}
inst_data %>%
plot_ly(
labels = ~ top_5,
values = ~ pct_by_group,
type = 'pie'
) %>%
layout(plot_bgcolor = 'rgb(236,240,245)') %>%
layout(paper_bgcolor = 'rgb(236,240,245)')
})
output$top_5_ts <- renderPlotly({
req(input$inst_data_date)
filt_date <- as.Date(input$inst_data_date)
if (!is.null(inst_click$multi_click)) {
investors_selected <- inst_data() %>%
dplyr::filter(calendardate == filt_date) %>%
slice(inst_click$multi_click) %>%
pull(investorname)
} else {
investors_selected <- inst_data() %>%
dplyr::filter(calendardate == filt_date) %>%
dplyr::filter(min_rank(desc(value)) <= 5) %>%
pull(investorname)
}
Quandl.datatable(
"SHARADAR/SF3",
ticker = input$ticker_1,
paginate = T,
securitytype = "SHR",
investorname = investors_selected
) %>%
select(-c(ticker, securitytype)) %>%
as_tibble() %>% mutate(investorname = as.factor(investorname)) %>%
plot_ly(
x = ~ calendardate,
y = ~ units,
color = ~ investorname,
type = "scatter",
mode = "lines"
) %>%
layout(plot_bgcolor = 'rgb(236,240,245)') %>%
layout(paper_bgcolor = 'rgb(236,240,245)')
})
output$inst_own_dt <- DT::renderDataTable({
req(input$inst_data_date)
filt_date <- as.Date(input$inst_data_date)
df <- inst_data() %>% filter(calendardate == filt_date)
df %>%
DT::datatable(
rownames = F,
selection = 'multiple',
class = 'cell-border stripe',
extensions = c('ColReorder', 'Scroller'),
options = list(
colReorder = TRUE,
deferRender = T,
scrollY = 300,
scroller = T
)
)
})
# Screening-----------------------------------------
output$index_name <- renderText({
req(input$index_id)
ishs_tbl %>% filter(ticker == input$index_id) %>% pull(name)
})
index_dt <- reactive({
req(input$index_id)
if (input$index_id == "CUST") {
full_join(q_indx("IVV", r_name = F), q_indx("IJR", r_name = F))
} else{
q_indx(input$index_id, r_name = F)
}
})
output$index_dt_dim_p <- renderText({
filt_n <- dim(filt_df())[[1]]
index_n <- dim(index_dt())[[1]]
p <-
c(ifelse(filt_n > index_n, index_n, filt_n),
" of ",
index_n,
"securities")
p
})
output$filt_dt_dim_c <- renderText({
filt_c <- dim(filt_df())[[2]]
p <- c(filt_c, "columns")
p
})
output$index_screen <- renderDataTable({
index_dt <- index_dt()
index_dt %>%
DT::datatable(rownames = F)
})
output$index_top <- renderPlotly({
dt <- index_dt() %>%
rename(weight = "Weight (%)") %>%
mutate(weight = weight / 100) %>%
group_by(Sector) %>%
mutate(group_weight = sum(weight, na.rm = T)) %>%
ungroup() %>%
arrange(desc(group_weight), desc(weight)) %>%
mutate(Sector = as_factor(Sector),
Ticker = as_factor(Ticker))
dt %>%
plot_ly(
x = ~ weight,
y = ~ Sector,
# color = dt$weight,
type = "bar",
hoverinfo = 'text',
text = ~ paste(
'Sector: ',
Sector,
'<br> Ticker: ',
Ticker,
'<br> Weight: ',
round(weight * 100, 2),
"%"
),
marker = list(
color = ~ weight,
# showscale=T,
colorscale = "Blues",
reversescale = T
)
) %>%
layout(
xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
side = "right"),
barmode = "stack",
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)'
)
})
output$index_exp <- renderPlotly({
index_dt() %>%
rename(weight = "Weight (%)") %>%
group_by(Sector) %>%
summarize(weight = sum(weight, na.rm = T) / 100) %>%
arrange(weight) %>%
mutate(Sector = as_factor(Sector)) %>%
plot_ly(
x = ~ weight,
y = ~ Sector,
type = "bar",
orientation = "h"
) %>%
layout(
xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
side = "right"),
showlegend = F
)
})
# Screening Paramaters-----------------------------------------------------------
output$hot_one <- renderRHandsontable({
tibble(params = c("***Example Comment***", rep_len(NA_character_, 19))) %>%
rhandsontable(stretchH = "all")
})
output$hot_two <- renderRHandsontable({
tibble(params = c("***Example Comment***", rep_len(NA_character_, 19))) %>%
rhandsontable(stretchH = "all")
})
output$hot_three <- renderRHandsontable({
# tibble(params = c("***Example Comment***",rep_len(NA_character_,39))) %>%
def_p <- read_csv(q_screen("screen_default_params")) %>%
pull(params)
tibble(params = c(def_p, rep_len(NA_character_, 100))) %>%
rhandsontable(stretchH = "all")
})
index_df <- reactive({
index_dt <- index_dt() %>%
dplyr::rename(
ticker = Ticker,
name = Name,
sector = Sector,
weight = "Weight (%)",
price = Price,
shares = Shares,
mkt_value = "Market Value"
)
index_df <- fund_data_screen %>%
filter(q_ticker %in% index_dt$ticker) %>%
group_by(q_ticker) %>%
filter(q_cal_date == max(q_cal_date, na.rm = T)) %>%
ungroup()
index_df <- index_dt %>%
dplyr::select(ticker, name, sector, price) %>%
left_join(index_df, by = c("ticker" = "q_ticker"))
index_df
})
df_vals <-
tibble(params = c("***Example Comment***", rep_len(NA_character_, 19)))
values <- reactiveValues(hot_one = df_vals,
hot_two = df_vals,
hot_three = df_vals)
## Handsontable Hot One----------------------
observe({
if (!is.null(input$hot_one)) {
values$hot_one <- hot_to_r(input$hot_one)
}
})
observe({
if (!is.null(input$hot_two)) {
values$hot_two <- hot_to_r(input$hot_two)
}
})
observe({
if (!is.null(input$hot_three)) {
values$hot_three <- hot_to_r(input$hot_three)
}
})
filt_df <- reactive({
hot_one <- values$hot_one
hot_two <- values$hot_two
hot_three <- values$hot_three
index_df <- index_df()
params <- bind_rows(hot_one, hot_two, hot_three)
params <- params %>%
filter(!is.na(params),
!is.null(params),
params != "",
!str_detect(params, "\\*\\*\\*"))
if (length(params$params) > 0) {
params <- params %>%
mutate(row_n = 1:nrow(.),
params = ifelse(
row_n == max(row_n, na.rm = T),
params,
paste0(params, "%>%")
)) %>%
pull(params) %>%
str_c(collapse = "")
} else {
params <- NULL
}
str_replace_all(params, "%>%", " %>%\n") %>% cat("\n")
if (length(params) >= 1) {
eval(parse(text = paste0("filt_df <- index_df %>%", params)))
} else {
filt_df <- index_df
}
filt_df
})
output$filtered_results_r <- renderRHandsontable({
filt_df() %>% rhandsontable(stretchH = "all") %>%
hot_cols(fixedColumnsLeft = 1) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
output$index_tree <- renderHighchart({
index_dt() %>%
rename(weight = "Weight (%)") %>%
hctreemap2(
group_vars = c("Sector"),
size_var = "weight",
layoutAlgorithm = "squarified",
levels = list(
list(level = 1, dataLabels = list(enabled = TRUE)),
list(level = 2, dataLabels = list(enabled = FALSE))
)
)
})
output$hist_select <- renderUI({
filt_df <- filt_df()
selection <- filt_df %>%
select_if(is.numeric) %>%
names()
selectInput(
inputId = "screen_hist_select",
label = "Select Column",
choices = selection,
selected = selection[[length(selection)]]
)
})
screen_select <- reactiveValues(hist = NULL)
observeEvent(input$screen_hist_select,
{
screen_select$hist <- input$screen_hist_select
})
output$screen_hist <- renderPlotly({
req(screen_select$hist)
req(input$screen_cut)
filt_df <- filt_df()
selection <- sym(screen_select$hist)
p <- hist_chart(filt_df, !!selection, input$screen_cut) %>%
layout(paper_bgcolor = 'rgb(255,255,255)',
plot_bgcolor = 'rgb(255,255,255)')
p
})
output$screen_box <- renderPlotly({
req(screen_select$hist)
req(input$screen_cut)
filt_df <- filt_df() %>%
mutate_if(is.numeric, funs(winsorize_x(., input$screen_cut))) %>%
group_by(sector) %>%
mutate_at(.vars = screen_select$hist, funs(cat = quantile(., na.rm =
T)[[4]])) %>%
arrange_at(.vars = vars(contains("cat"))) %>%
ungroup() %>%
mutate(sector = as_factor(sector))
sec_name <- filt_df %>%
select(contains("sector")) %>%
names()
if (!identical(sec_name, character(0))) {
filt_df %>%
plot_ly(
x = ~ get(screen_select$hist),
color = ~ get(sec_name),
type = "box"
) %>%
layout(xaxis = list(title = screen_select$hist),
showlegend = FALSE)
}
})
output$screen_perf <- renderPlotly({
ticks <- filt_df() %>%
pull(ticker)
ret %>%
filter(symbol %in% ticks) %>%
filter(date >= Sys.Date() %m-% years(1)) %>%
group_by(date) %>%
summarize(ret = mean(weekly_return, na.rm = T)) %>%
mutate(c_ret = with_order(date, cumprod, 1 + ret) - 1) %>%
plot_ly(x = ~ date,
y = ~ c_ret * 100) %>%
add_lines()
})
output$screen_tree <- renderHighchart({
filt_df() %>%
mutate(weight = 1) %>%
hctreemap2(
group_vars = c("sector"),
size_var = "weight",
layoutAlgorithm = "squarified",
levels = list(
list(level = 1, dataLabels = list(enabled = TRUE)),
list(level = 2, dataLabels = list(enabled = TRUE))
)
)
})
ret_hot <- reactive({
index_df <- index_df()
ret %>%
filter(symbol %in% index_df$ticker) %>%
filter(date >= input$clust_date %m-% years(2))
})
# Returns
cor_mat <- reactive({
wide_df <- ret_hot() %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
group_by(symbol) %>%
mutate(n = sum(ifelse(
near(weekly_return, 0) | is.na(weekly_return), 0, 1
))) %>%
ungroup() %>%
filter(n >= max(n, na.rm = T) * .9) %>%
select(-n) %>%
spread(symbol, weekly_return) %>%
select(-date) %>%
replace(is.na(.), 0) %>%
.[-1, ]
# Correlation Matrix
cor(wide_df, use = "complete.obs")
})
output$cor_mx <- renderRHandsontable({
# Returns
# ret <- pr %>%
# group_by(symbol) %>%
# tq_transmute(select = adjusted,
# mutate_fun = weeklyReturn,
# col_rename = "weekly_return")
corMat <- cor_mat()
# Spread Returns
# HC
hcg <- as.dist(1 - corMat) %>%
hclust(method = "complete") %>%
cutree(input$clust_cut) %>%
as.list() %>%
as_tibble() %>%
gather(rowname, Group)
by.cluster <- corMat %>%
as.data.frame() %>%
rownames_to_column() %>%
as_tibble() %>%
gather(Ticker, Corv, -rowname) %>%
filter(Corv != 1) %>%
left_join(hcg, by = "rowname") %>%
group_by(Ticker, Group) %>%
summarize(m.cor = mean(Corv, na.rm = T)) %>%
semi_join(hcg, by = c("Ticker" = "rowname", "Group")) %>%
arrange(desc(m.cor))
res <- by.cluster %>%
group_by(Group) %>%
add_tally() %>%
summarize(
group.m = mean(m.cor, na.rm = T),
n = as.integer(median(n)),
rank = group.m * sqrt(n)
) %>%
mutate(rank = min_rank(desc(rank))) %>%
left_join(by.cluster, by = "Group") %>%
select(Ticker, m.cor, everything()) %>%
arrange(rank)
if (is.null(input$clust_tick) | input$clust_tick == "") {
filt_ticks <- res %>% filter(rank == input$clust_rank) %>%
pull(Ticker)
} else{
r <- res %>% filter(Ticker == input$clust_tick) %>% pull(rank)
filt_ticks <- res %>% filter(rank == r) %>%
pull(Ticker)
}
cor_filt <- ret_hot() %>%
filter(symbol %in% filt_ticks) %>%
spread(symbol, weekly_return) %>%
.[-1, ] %>%
select(-date) %>%
cor(use = "complete.obs")
cor_filt %>%
rhandsontable(readOnly = TRUE) %>%
hot_cols(
renderer = "
function (instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.NumericRenderer.apply(this, arguments);
if (row == col) {
td.style.background = 'lightgrey';
} else if (col > row) {
td.style.color = 'grey';
td.style.background = 'grey';
} else if (value < 0) {
td.style.background = '#2166AC66';
} else if (value < 0.2) {
td.style.background = '#67A9CF66';
} else if (value < 0.4) {
td.style.background = '#D1E5F066';
} else if (value < 0.6) {
td.style.background = '#FDDBC766';
} else if (value < 0.8) {
td.style.background = '#EF8A6266';
} else if (value <= 1) {
td.style.background = '#B2182B66';
}
}"
) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
observe({
if (!is.null(input$cor_mx)) {
values$cor_mx <- hot_to_r(input$cor_mx) %>% as_tibble()
}
})
output$ret_filt <- renderPlotly({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
if (input$predict_rets == T) {
filt_d <- input$clust_date
} else {
filt_d <- input$clust_date %m-% years(1)
}
port <- ret %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
filter(symbol %in% clust_ticks_filter) %>%
filter(date >= filt_d) %>%
group_by(date) %>%
summarize(weekly_return = mean(weekly_return, na.rm = T)) %>%
mutate(
cum_ret = with_order(date, cumprod, 1 + weekly_return),
cum_max = with_order(date, cummax, cum_ret),
DD = cum_ret / cum_max - 1,
cum_ret = cum_ret - 1
) %>%
add_column(ticker = "Cluster EW", .before = 1)
# hrp_w <- ret_hot() %>%
# filter(symbol %in% clust_ticks_filter) %>%
# hrp_fun()
#
# hrp <- ret %>%
# filter(symbol %in% clust_ticks_filter) %>%
# filter(date >= input$clust_date[[2]]) %>%
# left_join(hrp_w,by = "symbol") %>%
# mutate(weekly_contr_return = weekly_return * out) %>%
# group_by(date) %>%
# summarize(weekly_return = sum(weekly_contr_return,na.rm = T)) %>%
# mutate(cum_ret = with_order(date,cumprod,1+weekly_return),
# cum_max = with_order(date,cummax,cum_ret),
# DD = cum_ret/cum_max - 1,
# cum_ret = cum_ret-1) %>%
# add_column(ticker = "HRP",.before = 1)
bench <- tq_get("SPY") %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
tq_transmute(select = adjusted,
mutate_fun = weeklyReturn,
col_rename = "weekly_return") %>%
filter(date >= filt_d) %>%
mutate(
cum_ret = with_order(date, cumprod, 1 + weekly_return),
cum_max = with_order(date, cummax, cum_ret),
DD = cum_ret / cum_max - 1,
cum_ret = cum_ret - 1
) %>%
add_column(ticker = "Bench", .before = 1)
plot.df <- port %>% full_join(bench)
perf.c <-
plot.df %>%
plot_ly(
x = ~ date,
y = ~ cum_ret,
color = ~ ticker,
type = "scatter",
mode = "lines",
name = ~ paste(ticker, "Total Return")
) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(
x = ~ date,
y = ~ weekly_return,
color = ~ ticker,
type = "bar",
name = ~ paste(ticker, "Weekly Return")
) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(
x = ~ date,
y = ~ DD,
color = ~ ticker,
type = "scatter",
mode = "lines",
name = ~ paste(ticker, "Drawdown")
) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = ""))
})
output$clust_screen <- renderRHandsontable({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
filt_df() %>% filter(ticker %in% clust_ticks_filter) %>%
rhandsontable(stretchH = "all") %>%
hot_cols(fixedColumnsLeft = 1) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
output$clust_tree <- renderHighchart({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
index_dt() %>%
filter(Ticker %in% clust_ticks_filter) %>%
rename(weight = "Weight (%)") %>%
hctreemap2(
group_vars = c("Sector", "Ticker"),
size_var = "weight",
layoutAlgorithm = "squarified",
levels = list(
list(level = 1, dataLabels = list(enabled = TRUE)),
list(level = 2, dataLabels = list(enabled = TRUE))
)
)
})
output$clust_returns_dt <- renderText({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
if (input$predict_rets) {
filt_d <- input$clust_date
} else {
filt_d <- input$clust_date %m-% years(1)
}
clust_port <- ret %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
filter(symbol %in% clust_ticks_filter) %>%
filter(date >= filt_d) %>%
group_by(date) %>%
summarize(weekly_return = mean(weekly_return, na.rm = T)) %>%
select(date, weekly_return)
bench <- tq_get("SPY") %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
tq_transmute(select = adjusted,
mutate_fun = weeklyReturn,
col_rename = "weekly_return") %>%
filter(date >= filt_d) %>%
select(date, bench_return = weekly_return)
combined_returns <-
left_join(clust_port, bench, by = c("date" = "date"))
annualized_returns <- clust_port %>%
tq_performance(Ra = weekly_return,
performance_fun = table.AnnualizedReturns) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
downside_risk <- clust_port %>%
tq_performance(Ra = weekly_return,
performance_fun = table.DownsideRisk) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
drawdowns_ratio <- clust_port %>%
tq_performance(Ra = weekly_return,
performance_fun = table.DrawdownsRatio) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
capm <- combined_returns %>%
tq_performance(Ra = weekly_return,
Rb = bench_return,
performance_fun = table.CAPM) %>%
gather(key, value) %>%
slice(1:7) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
information_ratio <- combined_returns %>%
tq_performance(Ra = weekly_return,
Rb = bench_return,
performance_fun = table.InformationRatio) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
specific_risk <- combined_returns %>%
tq_performance(Ra = weekly_return,
Rb = bench_return,
performance_fun = table.SpecificRisk) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
x <- bind_rows(
annualized_returns,
capm,
downside_risk,
drawdowns_ratio,
information_ratio,
specific_risk
) %>%
kable() %>%
group_rows("Annualized Return Statistics", 1, 3) %>%
group_rows("CAPM", 4, 10) %>%
group_rows("Downside Risk", 11, 21) %>%
group_rows("Drawdown Ratios", 22, 28) %>%
group_rows("Information Ratio", 29, 31) %>%
group_rows("Specific Risk", 32, 34)
gsub("<thead>.*</thead>", "", x)
})
})
)
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.
# Header ------------------------------------------------
header <-
dashboardHeader(title = shiny::tags$a(
shiny::tags$img(
src = "logo_r_equity_research_14.svg",
width = "200",
height = "31"
)
))
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(
sidebarSearchForm(
textId = "ticker_1",
buttonId = "searchButton",
label = "Ticker..."
),
sidebarMenu(
id = 'sidebarmenu',
menuItem(
'About Me',
tabName = 'me_overview',
icon = icon('id-card'),
menuSubItem("About Me",
tabName = "about_me")
),
# 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"
)
)
),
# Fundamental Indicators-----------------
menuItem(
'Fundamental Indicators',
tabName = 'fund_indicators',
icon = icon('industry'),
textInput(inputId = "compare_ticker",
"Comparison Ticker",
value = NULL),
menuItem(
"Value",
tabName = "value_ratios",
menuSubItem("Earnings Yield", "tab_earnings_yield"),
menuSubItem("Dividend Yield", "tab_dividend_yield"),
menuSubItem("Book Yield", "tab_book_to_price"),
menuSubItem("Operating CF Yield", "tab_ocf_yield"),
menuSubItem("Free Cash Flow Yield", "tab_fcf_yield"),
menuSubItem("Sales to Price", "tab_sales_to_price")
),
menuItem(
"Efficiency",
tabName = "eff_ratios",
menuSubItem("Inventory Turnover", "tab_inv_turn"),
menuSubItem("Receivables Turnover", "tab_rec_turn"),
menuSubItem("Asset Turnover", "tab_asset_turnover")
),
menuItem(
"Solvency",
tabName = "solve_ratios",
menuSubItem("Current Ratio", "tab_curr_ratio"),
menuSubItem("Cash Ratio", "tab_cash_ratio"),
menuSubItem("Debt to Assets", "tab_debt_to_assets"),
menuSubItem("Debt to Equity", "tab_debt_to_equity"),
menuSubItem("Debt to Capital", "tab_debt_to_capital")
),
menuItem(
"Profitability",
tabName = "profit_ratios",
menuSubItem("Gross Margin", "tab_gross_mgn"),
menuSubItem("Operating Margin", "tab_oper_mgn"),
menuSubItem("Profit Margin", "tab_profit_mgn"),
menuSubItem("Return on Assets", "tab_return_on_assets"),
menuSubItem("Return on Equity", "tab_return_on_equity")
)
),
# Fundamental Overview -------------------------
menuItem(
'Fundamental Data',
tabName = 'fundamental_data',
icon = icon('book'),
selectInput(
"fund_dim",
"Data Type",
c("As Reported" = "AR",
"Restated" = "MR"),
"AR"
),
selectInput(
"fund_freq",
"Frequency:",
c(
"Annual" = "Y",
"Quarterly" = "Q",
"Trailing Twelve Months" = "T"
),
"Y"
),
# Income Statement -------------------------
menuSubItem('Income Statement',
tabName = 'income_statement'),
# # Balance Sheet-----------------------
menuSubItem('Balance Sheet',
tabName = 'balance_sheet'),
# Cash Flow Statement------------------
menuSubItem('Cash Flow Statement',
tabName = 'cash_flow_statement'),
conditionalPanel(
"input.sidebarmenu === 'cash_flow_statement'",
selectizeInput(
inputId = 'cf_item',
label = "Graph Line Item:",
choices = c(
"Net Income" = "q_net_inc",
"Capital Expenditures" = "q_capex",
"CF - Business Acquisitions" = "q_cf_biz_acq",
"Investments" = "q_investments",
"Financing Cash Flow" = "q_cf_fin",
"Debt Issue" = "q_debt_issue",
"Equity Issue" = "q_equity_issue",
"Cash Distribution" = "q_cash_distr",
"Investing Cash Flow" = "q_cf_inv",
"Operating Cash Flow" = "q_cf_oper",
"Change In Cash" = "q_cf_cash",
"Share Compensation" = "q_share_comp",
"Depreciation & Amortization" = "q_depr_amort"
),
multiple = TRUE,
c("q_cf_fin", "q_cf_oper", "q_cf_inv")
)
)
),
# 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")
),
# 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"
)
)
),
# Ownership---------------------------
menuItem(
'Ownership',
tabName = 'ownership',
icon = icon('users'),
menuSubItem("Institutional Ownership", "ownership"),
conditionalPanel(
"input.sidebarmenu === 'ownership'",
uiOutput("inst_date_filter")
)
),
# Screening-----------------------------
menuItem(
'Screening',
tabName = 'screening',
icon = icon('filter'),
selectizeInput(
"index_id",
"Universe:",
choices = ishs_choices,
selected = "ITOT"
),
menuSubItem("Index Constits",
"constits"),
menuSubItem("Screening",
"screen"),
menuSubItem("Cluster Risk",
tabName = "hc"),
conditionalPanel(
"input.sidebarmenu === 'screen'",
numericInput(
"screen_cut",
"Cut:",
value = .05,
min = 0,
max = 1,
step = .01
)
),
conditionalPanel(
"input.sidebarmenu === 'hc'",
sliderInput(
"clust_date",
"Correlation Date Range:",
min = min(ret$date, na.rm =
T),
max = max(ret$date, na.rm = T),
value = max(ret$date, na.rm =
T),
step = months(3),
dragRange = T
),
sliderInput(
"clust_cut",
"# of Clusters",
min = 25,
max = 1000,
value = 700,
step = 50
),
numericInput("clust_rank",
"Cluster Rank:",
value = 1),
textInput("clust_tick",
"Ticker Filter:",
value = NULL),
checkboxInput("predict_rets",
"Forward Returns",
value = F)
)
)
)
)
# 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(
about_me,
tabItem(
tabName = "watchlist",
fluidRow(column(
6,
tabBox(
id = "tabset_watch",
height = "550px",
width = 12,
tabPanel("Watchlist",
withSpinner(dataTableOutput("watchlist_dt"))),
tabPanel("Short Port",
withSpinner(dataTableOutput("short_port_dt"))),
tabPanel("Sectors",
br(),
br(),
withSpinner(plotlyOutput(
"sector_returns_chart"
)))
)
),
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("Relative Perf",
withSpinner(plotlyOutput("ret_perf"))),
tabPanel("Key Stats",
br(),
br(),
withSpinner(dataTableOutput("key_stats")))
)
)),
fluidRow(column(
6,
tabBox(
id = "small_eq_fin",
height = "750px",
width = 12,
tabPanel("Income",
withSpinner(htmlOutput("sm_eq_inc_dt"))),
tabPanel("Assets",
withSpinner(htmlOutput("sm_eq_assets_dt"))),
tabPanel("Liabilities",
withSpinner(htmlOutput("sm_eq_liab_dt"))),
tabPanel("Equity",
withSpinner(htmlOutput("sm_eq_equity_dt"))),
tabPanel("Cash Flow",
withSpinner(htmlOutput("sm_eq_cf_dt")))
)
),
column(
6,
tabBox(
id = "watchlist_4",
height = "750px",
width = 12,
tabPanel("Filings",
withSpinner(dataTableOutput("filing_short"))),
tabPanel("Ownership",
br(),
br(),
withSpinner(plotlyOutput("own_pie")))
)
))
),
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")))
),
# Income Statement ----------------------------------
tabItem(tabName = "income_statement",
fluidRow(column(
12,
withSpinner(plotlyOutput(outputId = "waterfall_chart"))
)),
fluidRow(column(
12,
htmlOutput("income_statement_dt")
))),
# Balance Sheet ----------------------------------
tabItem(tabName = "balance_sheet",
# Creating Columns and Rows ------------------------------------
fluidRow(column(
12,
withSpinner(highchartOutput(outputId = "balance_sheet_treemap"))
)),
fluidRow(
tabBox(
id = "tabset_3",
height = "600px",
width = 12,
tabPanel("Assets",
htmlOutput("assets_dt")),
tabPanel("Liabilities",
htmlOutput("liab_dt")),
tabPanel("Equity",
htmlOutput("equity_dt"))
)
)),
# Cash Flow Statement ----------------------------------
tabItem(tabName = "cash_flow_statement",
fluidRow(column(
12, withSpinner(plotlyOutput("cf_graph"))
)),
# Creating Columns and Rows ------------------------------------
fluidRow(column(
12, htmlOutput("cf_dt")
))),
# Fundamental Indicators------------------
# Value Ratios-------------------
full_page("tab_earnings_yield",
withSpinner(
highchartOutput("earnings_yield", height = "750px")
)),
full_page("tab_dividend_yield",
withSpinner(
highchartOutput("div_yield", height = "750px")
)),
full_page("tab_book_to_price",
withSpinner(
highchartOutput("book_yield", height = "750px")
)),
full_page("tab_ocf_yield",
withSpinner(
highchartOutput("ocf_yield", height = "750px")
)),
full_page("tab_fcf_yield",
withSpinner(
highchartOutput("fcf_yield", height = "750px")
)),
full_page("tab_sales_to_price",
withSpinner(
highchartOutput("sales_yield", height = "750px")
)),
# Efficiency Ratios------------------
full_page("tab_inv_turn",
withSpinner(
highchartOutput("inv_turn", height = "750px")
)),
full_page("tab_rec_turn",
withSpinner(
highchartOutput("rec_turn", height = "750px")
)),
full_page("tab_asset_turnover",
withSpinner(
highchartOutput("asset_turn", height = "750px")
)),
#Solvency Ratios -----------------
full_page("tab_curr_ratio",
withSpinner(
highchartOutput("curr_ratio", height = "750px")
)),
full_page("tab_cash_ratio",
withSpinner(
highchartOutput("cash_ratio", height = "750px")
)),
full_page("tab_debt_to_assets",
withSpinner(
highchartOutput("debt_to_assets", height = "750px")
)),
full_page("tab_debt_to_equity",
withSpinner(
highchartOutput("debt_to_equity", height = "750px")
)),
full_page("tab_debt_to_capital",
withSpinner(
highchartOutput("debt_to_capital", height = "750px")
)),
# Profitability Ratios---------------
full_page("tab_gross_mgn",
withSpinner(
highchartOutput("gross_margin", height = "750px")
)),
full_page("tab_oper_mgn",
withSpinner(
highchartOutput("operating_margin", height = "750px")
)),
full_page("tab_profit_mgn",
withSpinner(
highchartOutput("profit_margin", height = "750px")
)),
full_page("tab_return_on_assets",
withSpinner(
highchartOutput("return_on_assets", height = "750px")
)),
full_page("tab_return_on_equity",
withSpinner(
highchartOutput("return_on_equity", height = "750px")
)),
# 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")
)))
)
#
# fluidRow(column(12,withSpinner(rHandsontableOutput("cor_mx", height ="900px")))),
#
# # full_row(rHandsontableOutput("cor_mx")),
# full_row(plotlyOutput("ret_filt"))
)
)
)
# APP ------------------------------------------------
shinyApp(
ui <- dashboardPage(title = "Equity Research",
header,
sidebar,
body,
skin = "black"),
# Server ----------------------------------------------------------
shinyServer(function(input, output) {
# Watchlist Script------------------------------------------------
output$polar_chart <- renderPlotly({
plot_ly(type = 'scatterpolar',
fill = 'toself') %>%
add_trace(
r = c(25, 25, 25, 0, 0, 0),
theta = c(
"Consulting",
"Education",
"Analyst",
"Asset Management",
"Coding",
"Data Science"
),
name = 'Experience',
fillcolor = 'rgba(55, 128, 191, 0.5)',
marker = list(color = "black")
) %>%
add_trace(
r = c(0, 0, 25, 25, 25, 25),
theta = c(
"Consulting",
"Education",
"Analyst",
"Asset Management",
"Coding",
"Data Science"
),
name = 'Capstone',
fillcolor = 'rgba(50, 171, 96, 0.5)',
marker = list(color = "black")
) %>%
layout(
polar = list(radialaxis = list(
visible = T,
range = c(0, 50)
)),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)'
)
})
output$ideal_map <- renderHighchart({
ideal_location()
})
output$invest_style <- renderPlotly({
my_style %>%
# group_by(category) %>%
arrange(desc(value)) %>%
mutate(name = as_factor(name)) %>%
# mutate(row_n = 1:nrow(.)) %>% arrange(desc(row_n)) %>%
# arrange(order) %>%
# mutate(category = fct_reorder(category,order)) %>%
plot_ly(
x = ~ value,
y = ~ category,
# sort = F,
type = "bar",
color = ~ value,
colors = 'Blues',
# marker = list(color = ~color),
orientation = "h",
name = ~ name
) %>%
layout(
yaxis = list(title = ''),
xaxis = list(title = ''),
barmode = 'stack'
) %>%
hide_colorbar() %>%
layout(
legend = list(orientation = 'h', y = -0.1),
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)'
)
})
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$short_port_dt <- renderDataTable({
short_port <- read_csv(q_trash("short_port"))
# Daily Performance------------------------------------
short_q <- short_port %>%
pull(ticker) %>%
map_df(q_quote)
short_q %>%
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$sm_eq_inc_dt <- renderText({
validate(need(
!is.null(input$watchlist_dt_rows_selected),
"Select a Security to View Financials"
))
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_inc_fmt_tbl(ticker, n = 3)
})
# Assets Sub Plot---------------------------------------------
output$sm_eq_assets_dt <- 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_bal_fmt_tbl(ticker, n = 3)
})
output$sm_eq_liab_dt <- 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_bal_fmt_tbl(ticker,
selection = "liab",
n = 3)
})
output$sm_eq_equity_dt <- 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_bal_fmt_tbl(ticker,
selection = "equity",
n = 3)
})
output$sm_eq_cf_dt <- 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_cf_fmt_tbl(ticker,
n = 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_2 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1, " Frequently Mentioned With")
})
output$title_3 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1, " Company Description")
})
output$title_4 <- renderText({
req(input$ticker_1)
paste0(input$ticker_1, " Frequent News Buzzwords")
})
output$key_info <- renderDataTable({
req(input$ticker_1)
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>")
# descrip <- descrip %>%
# str_split(" ") %>%
# as_vector() %>%
# tibble(word = .) %>%
# mutate(word = ifelse(!(word %in% stop_words$word),
# paste0("<b>",word,"</b>"),
# paste0('<font color = "#ECF0F5">',word,"</font>"))) %>%
# pull(word) %>%
# paste(sep = " ",collapse = " ")
#
# paste0("<h4>",descrip,"</h4>")
# %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# inner_join(sentiments) %>%
# distinct(word) %>%
# mutate(word = paste(word,"<br>")) %>%
# pull()
# descrip %>%
# tibble(word = .) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# pull(word) %>%
# paste(sep = "",collapse = "")
# as.vector(strsplit(descrip, '\\. ')) %>%
# tibble(word = .) %>%
# unnest(word) %>%
# mutate(line = 1:nrow(.)) %>%
# unnest_tokens(word,word) %>%
# anti_join(stop_words) %>%
# nest(word) %>%
# mutate(text = map(data,unlist),
# text = map_chr(text, paste, collapse = " "),
# text = paste(text,"<br>")) %>%
# pull(text)
})
# IS Waterfall Chart---------------------------------------------
output$waterfall_chart <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
df <-
q_income_statement(ticker, dimension = paste0(input$fund_dim, input$fund_freq))
df <- df[1, ]
dat_graph <-
tibble(
x = c(
'Revenue',
'COGS',
'Gross Margin',
'Op Ex',
'RND',
'SGA',
'Op Income',
'Other Inc',
'EBIT',
'Interest and Taxes',
'Net Income'
),
base = c(
0,
df$q_gross_profit,
0,
df$q_oper_inc,
(df$q_gross_profit - df$q_rnd),
df$q_oper_inc,
0,
ifelse(
df$q_other_income > 0,
df$q_oper_inc,
df$q_oper_inc + df$q_other_income
),
0,
ifelse(
df$q_interest_nd_tax > 0,
df$q_ebit,
df$q_ebit + df$q_interest_nd_tax
),
0
),
revenues = c(
df$q_revenue,
rep(0, 6),
ifelse(df$q_other_income > 0 , df$q_other_income, 0),
0,
ifelse(df$q_interest_nd_tax > 0, df$q_interest_nd_tax, 0),
0
),
costs = c(
0,
df$q_cogs,
0,
df$q_oper_exp,
df$q_rnd,
df$q_sgna,
0,
ifelse(df$q_other_income < 0 ,-df$q_other_income, 0),
0,
ifelse(df$q_interest_nd_tax < 0,-df$q_interest_nd_tax, 0),
0
),
profit = c(
0,
0,
df$q_gross_profit,
rep(0, 3),
df$q_oper_inc,
0,
df$q_ebit,
0,
df$q_net_inc
)
)
dat_graph <- dat_graph %>%
filter(!(x %in% c("RND", "SGA"))) %>%
mutate(y = ifelse(
costs == 0,
sum(base, revenues, costs, profit) / 2,
base + (costs / 2)
))
#The default order will be alphabetized unless specified as below:
dat_graph$x <- factor(dat_graph$x, levels = dat_graph[["x"]])
plot_ly(
dat_graph,
x = ~ x,
y = ~ base,
type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)')
) %>%
add_trace(
y = ~ revenues,
marker = list(
color = 'rgba(55, 128, 191, 0.7)',
line = list(color = 'rgba(55, 128, 191, 0.7)',
width = 2)
)
) %>%
add_trace(
y = ~ costs,
marker = list(
color = 'rgba(219, 64, 82, 0.7)',
line = list(color = 'rgba(219, 64, 82, 1.0)',
width = 2)
)
) %>%
add_trace(
y = ~ profit,
marker = list(
color = 'rgba(50, 171, 96, 0.7)',
line = list(color = 'rgba(50, 171, 96, 1.0)',
width = 2)
)
) %>%
layout(
title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)',
showlegend = FALSE
)
})
# Income Statement DataTable--------------------------------------------------
output$income_statement_dt <- renderText({
req(input$ticker_1)
q_inc_fmt_tbl(
ticker = input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq)
)
})
# BS Treemap--------------------------------------------------
output$balance_sheet_treemap <- renderHighchart({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
bal_sheet <-
q_balance_sheet(ticker, dimension = paste0(input$fund_dim, input$fund_freq)) %>%
dplyr::select(
q_cal_date,
q_cash,
q_invest_curr,
q_receivables,
q_inventory,
q_other_curr_assets,
q_invest_non_curr,
q_ppe,
q_assets_good_intang,
q_other_non_curr_assets,
q_payables,
q_debt_curr,
q_other_curr_liab,
q_debt_non_curr,
q_other_non_curr_liab,
q_retained_earn,
q_other_equity
)
# Generate Data for Treemap ---------------------
tm <- bal_sheet %>%
dplyr::filter(q_cal_date == max(q_cal_date, na.rm = T)) %>%
gather(q_lo, value,-q_cal_date) %>%
left_join(bal_sheet_tree_ref, by = "q_lo") %>%
rename(descrip = name) %>%
mutate_at("main_group", str_replace, "Equity", "Shareholders Equity") %>%
mutate(color_numeric = as.numeric(as.factor(main_group)))
# Generate Data Classes Colors------------------------------------------
data_classes <- list(
list(
from = 1,
to = 1,
color = "#3780bf",
name = "Assets"
),
list(
from = 2,
to = 2,
color = "#db4052",
name = "Liabilities"
),
list(
from = 3,
to = 3,
color = "#32ab60",
name = "Shareholders Equity"
)
)
hctreemap2(
tm,
group_vars = c("main_group", "sub_group", "descrip"),
size_var = "value",
color_var = "color_numeric",
layoutAlgorithm = "squarified"
) %>%
hc_colorAxis(dataClassColor = "category",
dataClasses = data_classes)
})
# Balance Sheet Data Tables ----------------------------
output$assets_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq))
})
output$liab_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(
input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq),
selection = "liab"
)
})
output$equity_dt <- renderText({
req(input$ticker_1)
q_bal_fmt_tbl(
input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq),
selection = "equity"
)
})
# CF Graph ---------------------------------------
output$cf_graph <- renderPlotly({
req(input$ticker_1)
ticker <- as.character(input$ticker_1)
cf_statement <-
q_cash_flow_statement(ticker, dimension = paste0(input$fund_dim, input$fund_freq)) %>%
slice(1:10)
if (!is.null(input$cf_item)) {
cf_statement %>%
select(q_cal_date, input$cf_item) %>%
gather(indicator, value, -q_cal_date) %>%
plot_ly(
x = ~ q_cal_date,
y = ~ value,
color = ~ indicator,
type = "bar"
) %>%
layout(paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)')
}
})
# CF Data Tables----------------------------------------
output$cf_dt <- renderText({
req(input$ticker_1)
q_cf_fmt_tbl(input$ticker_1,
dimension = paste0(input$fund_dim, input$fund_freq))
})
# Fundamental Indicators--------------------------------
ticker_price <- reactive({
req(input$ticker_1)
# req(input$compare_ticker)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
ticker_price <- tq_get(ticker)
if (!("symbol" %in% colnames(ticker_price))) {
ticker_price <- ticker_price %>% mutate(symbol = input$ticker_1)
}
ticker_price <- ticker_price %>%
select(symbol, date, adjusted) %>%
spread(symbol, adjusted)
ticker_price <-
seq.Date(min(ticker_price$date), max(ticker_price$date), by = "days") %>%
tibble(date = .) %>%
left_join(ticker_price, by = "date") %>%
fill(-date) %>%
gather(symbol, adjusted, -date)
ticker_price
})
# Earnings Yield
output$earnings_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_eps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(earnings_yield = q_eps / adjusted) %>%
select(-c(q_eps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = earnings_yield,
group = q_ticker)) %>%
hc_title(text = "Earnings Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Dividend Yield div/price
output$div_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_divs_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(dividend_yield = q_divs_ps / adjusted) %>%
select(-c(q_divs_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = dividend_yield,
group = q_ticker)) %>%
hc_title(text = "Dividend Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Book Value PS/ Price
output$book_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
convert = T,
dimension = "ART",
cols = c("q_bv_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(book_yield = q_bv_ps / adjusted) %>%
select(-c(q_bv_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = book_yield,
group = q_ticker)) %>%
hc_title(text = "Book to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Operating CF Yield OCF PS/Price
output$ocf_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cf_oper", "q_shares"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(oper_cf_yield = (q_cf_oper / q_shares) / adjusted) %>%
select(-c(q_cf_oper, q_shares, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = oper_cf_yield,
group = q_ticker)) %>%
hc_title(text = "Operating Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# FCF Yield PS / Price
output$fcf_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_fcf_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(fcf_yield = q_fcf_ps / adjusted) %>%
select(-c(q_fcf_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = fcf_yield,
group = q_ticker)) %>%
hc_title(text = "Free Cash Flow Yield") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Sales PS / Price
output$sales_yield <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_sales_ps"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
filter(q_cal_date >= min(ticker_price()$date, na.rm = T))
df <- df %>%
left_join(ticker_price(),
by = c("q_ticker" = "symbol", "q_cal_date" = "date")) %>%
mutate(sales_yield = q_sales_ps / adjusted) %>%
select(-c(q_sales_ps, adjusted))
hchart(df,
type = "line",
hcaes(x = q_cal_date,
y = sales_yield,
group = q_ticker)) %>%
hc_title(text = "Sales to Price") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Inventory Turnover
output$inv_turn <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cogs", "q_inventory"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(inventory_turnover = q_cogs / q_inventory) %>%
select(-c(q_cogs, q_inventory))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = inventory_turnover,
group = q_ticker)) %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
)) %>%
hc_title(text = "Inventory Turnover")
})
# Recievables Turnover
output$rec_turn <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue", "q_receivables"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(receivables_turnover = q_revenue / q_receivables) %>%
select(-c(q_revenue, q_receivables))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = receivables_turnover,
group = q_ticker)) %>%
hc_title(text = "Receivables Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Asset Turnover
output$asset_turn <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_revenue", "q_assets"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(asset_turnover = q_revenue / q_assets) %>%
select(-c(q_revenue, q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = asset_turnover,
group = q_ticker)) %>%
hc_title(text = "Asset Turnover") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Current Ratio
output$curr_ratio <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_assets_curr", "q_liab_curr"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(current_ratio = q_assets_curr / q_liab_curr) %>%
select(-c(q_assets_curr, q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = current_ratio,
group = q_ticker)) %>%
hc_title(text = "Current Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Cash Ratio
output$cash_ratio <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_cash", "q_investments", "q_receivables", "q_liab_curr"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(cash_ratio = (q_cash + q_investments + q_receivables) / q_liab_curr) %>%
select(-c(q_cash, q_investments, q_receivables, q_liab_curr))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = cash_ratio,
group = q_ticker)) %>%
hc_title(text = "Cash Ratio") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Debt to Assets
output$debt_to_assets <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt", "q_assets"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(debt_to_assets = q_debt / q_assets) %>%
select(-c(q_debt, q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_assets,
group = q_ticker)) %>%
hc_title(text = "Debt to Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Debt to Capital
output$debt_to_capital <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt", "q_equity"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(debt_to_capital = q_debt / (q_debt + q_equity)) %>%
select(-c(q_debt, q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_capital,
group = q_ticker)) %>%
hc_title(text = "Debt to Capital") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Debt to Equity
output$debt_to_equity <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_debt", "q_equity"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(debt_to_equity = q_debt / q_equity) %>%
select(-c(q_debt, q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = debt_to_equity,
group = q_ticker)) %>%
hc_title(text = "Debt to Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Profitability Ratios
# Gross Profit Margin
output$gross_margin <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_gross_profit", "q_revenue")
) %>%
mutate(gross_margin = q_gross_profit / q_revenue) %>%
select(-c(q_gross_profit, q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = gross_margin,
group = q_ticker)) %>%
hc_title(text = "Gross Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Operating Profit Margin
output$operating_margin <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_oper_inc", "q_revenue"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(operating_margin = q_oper_inc / q_revenue) %>%
select(-c(q_oper_inc, q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = operating_margin,
group = q_ticker)) %>%
hc_title(text = "Operating Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# Net Profit Margin
output$profit_margin <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc", "q_revenue"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(profit_margin = q_net_inc / q_revenue) %>%
select(-c(q_net_inc, q_revenue))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = profit_margin,
group = q_ticker)) %>%
hc_title(text = "Profit Margin") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# ROA
output$return_on_assets <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc", "q_assets"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(return_on_assets = q_net_inc / q_assets) %>%
select(-c(q_net_inc, q_assets))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_assets,
group = q_ticker)) %>%
hc_title(text = "Return on Assets") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# ROE
output$return_on_equity <- renderHighchart({
req(input$ticker_1)
if (is.null(input$compare_ticker) | input$compare_ticker == "") {
ticker <- input$ticker_1
} else {
comps <- str_split(input$compare_ticker, ",") %>%
as_vector()
ticker <- c(input$ticker_1, comps)
}
df <- q_dat(
ticker = ticker,
dimension = "ART",
convert = T,
cols = c("q_net_inc", "q_equity"),
calendardate.gte = Sys.Date() %m-% years(10)
) %>%
mutate(return_on_equity = q_net_inc / q_equity) %>%
select(-c(q_net_inc, q_equity))
hchart(df,
"line",
hcaes(x = q_cal_date,
y = return_on_equity,
group = q_ticker)) %>%
hc_title(text = "Return on Equity") %>%
hc_rangeSelector(enabled = T,
buttons = list(
list(type = 'all', text = 'All'),
list(
type = 'year',
count = 10,
text = '10Y'
),
list(
type = 'year',
count = 5,
text = '5Y'
),
list(
type = 'year',
count = 3,
text = '3Y'
)
))
})
# 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]]
)
# df <- q_price(ticker,
# start_date = input$price_date_range[[1]],
# end_date = input$price_date_range[[2]],
# frequency = input$price_freq) %>%
# select(q_ticker,
# date,
# adjOpen,
# adjLow,
# adjHigh,
# adjClose,
# adjVolume,
# divCash,
# splitFactor)
#
# df
})
# 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')
})
# tr_script <- reactive({
# q_transcript(input$ticker_1)
#
#
# })
#
#
#
# # Filings ---------------------------------
# output$transcript <- renderDataTable({
# library(rebus)
# req(input$ticker_1)
#
#
# tp <- tr_script() %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title)
#
# tp %>%
# DT::datatable(escape = F, rownames = F,
# options = list(pageLength = 20,
# columnDefs = list(list(className = 'dt-center',targets = "_all"))))
#
#
# })
# output$tr_df <- renderDataTable({
#
# library(rebus)
# t <- t_script
#
# t <- t %>%
# mutate(st = str_locate(link,"-") %>% .[[1]],
# title = str_sub(link,st+1),
# title = str_replace_all(title,"-"," "),
# title = str_to_upper(title)) %>%
# mutate(q_one = str_extract(title,"Q" %R% DGT %R% SPACE %R% one_or_more(DGT)),
# q_two = str_extract(title,one_or_more(DGT) %R% SPACE %R% "Q" %R% DGT),
# period = ifelse(!is.na(q_one),q_one,q_two)) %>%
# select(period,title,link) %>%
# mutate(title = paste0("<a href='",link,"' target='_blank'>",title,"</a>")) %>%
# select(period,title) %>% datatable(escape = F)
#
# t
#
# })
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_y") +
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)')
})
# Ownership -----------------------------
output$inst_date_filter <- renderUI({
req(input$ticker_1)
d_dates <- Quandl.datatable(
"SHARADAR/SF1",
ticker = input$ticker_1,
dimension = "ARQ",
qopts.columns = "calendardate"
) %>%
dplyr::filter(calendardate >= as.Date("2012-12-30"))
selected_date <-
d_dates %>% arrange(desc(calendardate)) %>% filter(1:nrow(.) == 2) %>% pull()
# selected_date <- last_day(Sys.Date())
selectInput(
inputId = "inst_data_date",
label = "Select Calendar Date",
choices = d_dates$calendardate,
selected = selected_date
)
})
inst_data <- reactive({
req(input$ticker_1)
req(input$inst_data_date)
df <- Quandl.datatable(
"SHARADAR/SF3",
ticker = input$ticker_1,
paginate = T,
securitytype = "SHR",
calendardate = input$inst_data_date
) %>%
select(-c(ticker, securitytype)) %>%
as_tibble()
df
})
inst_click <- reactiveValues(multi_click = NULL)
observeEvent(input$inst_own_dt_rows_selected,
{
inst_click$multi_click <- input$inst_own_dt_rows_selected
})
output$top_5_pie <- renderPlotly({
req(input$inst_data_date)
all_sh_sum <- sum(inst_data()$value)
if (!is.null(inst_click$multi_click)) {
inst_data <- inst_data() %>%
mutate(top_5 = ifelse(
1:nrow(.) %in% input$inst_own_dt_rows_selected,
investorname,
"Other"
)) %>%
group_by(top_5) %>%
summarize(pct_by_group = sum(value, na.rm = T) / all_sh_sum)
} else {
inst_data <- inst_data() %>%
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)
}
inst_data %>%
plot_ly(
labels = ~ top_5,
values = ~ pct_by_group,
type = 'pie'
) %>%
layout(plot_bgcolor = 'rgb(236,240,245)') %>%
layout(paper_bgcolor = 'rgb(236,240,245)')
})
output$top_5_ts <- renderPlotly({
req(input$inst_data_date)
filt_date <- as.Date(input$inst_data_date)
if (!is.null(inst_click$multi_click)) {
investors_selected <- inst_data() %>%
dplyr::filter(calendardate == filt_date) %>%
slice(inst_click$multi_click) %>%
pull(investorname)
} else {
investors_selected <- inst_data() %>%
dplyr::filter(calendardate == filt_date) %>%
dplyr::filter(min_rank(desc(value)) <= 5) %>%
pull(investorname)
}
Quandl.datatable(
"SHARADAR/SF3",
ticker = input$ticker_1,
paginate = T,
securitytype = "SHR",
investorname = investors_selected
) %>%
select(-c(ticker, securitytype)) %>%
as_tibble() %>% mutate(investorname = as.factor(investorname)) %>%
plot_ly(
x = ~ calendardate,
y = ~ units,
color = ~ investorname,
type = "scatter",
mode = "lines"
) %>%
layout(plot_bgcolor = 'rgb(236,240,245)') %>%
layout(paper_bgcolor = 'rgb(236,240,245)')
})
output$inst_own_dt <- DT::renderDataTable({
req(input$inst_data_date)
filt_date <- as.Date(input$inst_data_date)
df <- inst_data() %>% filter(calendardate == filt_date)
df %>%
DT::datatable(
rownames = F,
selection = 'multiple',
class = 'cell-border stripe',
extensions = c('ColReorder', 'Scroller'),
options = list(
colReorder = TRUE,
deferRender = T,
scrollY = 300,
scroller = T
)
)
})
# Screening-----------------------------------------
output$index_name <- renderText({
req(input$index_id)
ishs_tbl %>% filter(ticker == input$index_id) %>% pull(name)
})
index_dt <- reactive({
req(input$index_id)
if (input$index_id == "CUST") {
full_join(q_indx("IVV", r_name = F), q_indx("IJR", r_name = F))
} else{
q_indx(input$index_id, r_name = F)
}
})
output$index_dt_dim_p <- renderText({
filt_n <- dim(filt_df())[[1]]
index_n <- dim(index_dt())[[1]]
p <-
c(ifelse(filt_n > index_n, index_n, filt_n),
" of ",
index_n,
"securities")
p
})
output$filt_dt_dim_c <- renderText({
filt_c <- dim(filt_df())[[2]]
p <- c(filt_c, "columns")
p
})
output$index_screen <- renderDataTable({
index_dt <- index_dt()
index_dt %>%
DT::datatable(rownames = F)
})
output$index_top <- renderPlotly({
dt <- index_dt() %>%
rename(weight = "Weight (%)") %>%
mutate(weight = weight / 100) %>%
group_by(Sector) %>%
mutate(group_weight = sum(weight, na.rm = T)) %>%
ungroup() %>%
arrange(desc(group_weight), desc(weight)) %>%
mutate(Sector = as_factor(Sector),
Ticker = as_factor(Ticker))
dt %>%
plot_ly(
x = ~ weight,
y = ~ Sector,
# color = dt$weight,
type = "bar",
hoverinfo = 'text',
text = ~ paste(
'Sector: ',
Sector,
'<br> Ticker: ',
Ticker,
'<br> Weight: ',
round(weight * 100, 2),
"%"
),
marker = list(
color = ~ weight,
# showscale=T,
colorscale = "Blues",
reversescale = T
)
) %>%
layout(
xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
side = "right"),
barmode = "stack",
paper_bgcolor = 'rgb(236,240,245)',
plot_bgcolor = 'rgb(236,240,245)'
)
})
output$index_exp <- renderPlotly({
index_dt() %>%
rename(weight = "Weight (%)") %>%
group_by(Sector) %>%
summarize(weight = sum(weight, na.rm = T) / 100) %>%
arrange(weight) %>%
mutate(Sector = as_factor(Sector)) %>%
plot_ly(
x = ~ weight,
y = ~ Sector,
type = "bar",
orientation = "h"
) %>%
layout(
xaxis = list(title = "",
tickformat = ".2%"),
yaxis = list(title = "",
side = "right"),
showlegend = F
)
})
# Screening Paramaters-----------------------------------------------------------
output$hot_one <- renderRHandsontable({
tibble(params = c("***Example Comment***", rep_len(NA_character_, 19))) %>%
rhandsontable(stretchH = "all")
})
output$hot_two <- renderRHandsontable({
tibble(params = c("***Example Comment***", rep_len(NA_character_, 19))) %>%
rhandsontable(stretchH = "all")
})
output$hot_three <- renderRHandsontable({
# tibble(params = c("***Example Comment***",rep_len(NA_character_,39))) %>%
def_p <- read_csv(q_screen("screen_default_params")) %>%
pull(params)
tibble(params = c(def_p, rep_len(NA_character_, 100))) %>%
rhandsontable(stretchH = "all")
})
index_df <- reactive({
index_dt <- index_dt() %>%
dplyr::rename(
ticker = Ticker,
name = Name,
sector = Sector,
weight = "Weight (%)",
price = Price,
shares = Shares,
mkt_value = "Market Value"
)
index_df <- fund_data_screen %>%
filter(q_ticker %in% index_dt$ticker) %>%
group_by(q_ticker) %>%
filter(q_cal_date == max(q_cal_date, na.rm = T)) %>%
ungroup()
index_df <- index_dt %>%
dplyr::select(ticker, name, sector, price) %>%
left_join(index_df, by = c("ticker" = "q_ticker"))
index_df
})
df_vals <-
tibble(params = c("***Example Comment***", rep_len(NA_character_, 19)))
values <- reactiveValues(hot_one = df_vals,
hot_two = df_vals,
hot_three = df_vals)
## Handsontable Hot One----------------------
observe({
if (!is.null(input$hot_one)) {
values$hot_one <- hot_to_r(input$hot_one)
}
})
observe({
if (!is.null(input$hot_two)) {
values$hot_two <- hot_to_r(input$hot_two)
}
})
observe({
if (!is.null(input$hot_three)) {
values$hot_three <- hot_to_r(input$hot_three)
}
})
filt_df <- reactive({
hot_one <- values$hot_one
hot_two <- values$hot_two
hot_three <- values$hot_three
index_df <- index_df()
params <- bind_rows(hot_one, hot_two, hot_three)
params <- params %>%
filter(!is.na(params),
!is.null(params),
params != "",
!str_detect(params, "\\*\\*\\*"))
if (length(params$params) > 0) {
params <- params %>%
mutate(row_n = 1:nrow(.),
params = ifelse(
row_n == max(row_n, na.rm = T),
params,
paste0(params, "%>%")
)) %>%
pull(params) %>%
str_c(collapse = "")
} else {
params <- NULL
}
str_replace_all(params, "%>%", " %>%\n") %>% cat("\n")
if (length(params) >= 1) {
eval(parse(text = paste0("filt_df <- index_df %>%", params)))
} else {
filt_df <- index_df
}
filt_df
})
output$filtered_results_r <- renderRHandsontable({
filt_df() %>% rhandsontable(stretchH = "all") %>%
hot_cols(fixedColumnsLeft = 1) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
output$index_tree <- renderHighchart({
index_dt() %>%
rename(weight = "Weight (%)") %>%
hctreemap2(
group_vars = c("Sector"),
size_var = "weight",
layoutAlgorithm = "squarified",
levels = list(
list(level = 1, dataLabels = list(enabled = TRUE)),
list(level = 2, dataLabels = list(enabled = FALSE))
)
)
})
output$hist_select <- renderUI({
filt_df <- filt_df()
selection <- filt_df %>%
select_if(is.numeric) %>%
names()
selectInput(
inputId = "screen_hist_select",
label = "Select Column",
choices = selection,
selected = selection[[length(selection)]]
)
})
screen_select <- reactiveValues(hist = NULL)
observeEvent(input$screen_hist_select,
{
screen_select$hist <- input$screen_hist_select
})
output$screen_hist <- renderPlotly({
req(screen_select$hist)
req(input$screen_cut)
filt_df <- filt_df()
selection <- sym(screen_select$hist)
p <- hist_chart(filt_df, !!selection, input$screen_cut) %>%
layout(paper_bgcolor = 'rgb(255,255,255)',
plot_bgcolor = 'rgb(255,255,255)')
p
})
output$screen_box <- renderPlotly({
req(screen_select$hist)
req(input$screen_cut)
filt_df <- filt_df() %>%
mutate_if(is.numeric, funs(winsorize_x(., input$screen_cut))) %>%
group_by(sector) %>%
mutate_at(.vars = screen_select$hist, funs(cat = quantile(., na.rm =
T)[[4]])) %>%
arrange_at(.vars = vars(contains("cat"))) %>%
ungroup() %>%
mutate(sector = as_factor(sector))
sec_name <- filt_df %>%
select(contains("sector")) %>%
names()
if (!identical(sec_name, character(0))) {
filt_df %>%
plot_ly(
x = ~ get(screen_select$hist),
color = ~ get(sec_name),
type = "box"
) %>%
layout(xaxis = list(title = screen_select$hist),
showlegend = FALSE)
}
})
output$screen_perf <- renderPlotly({
ticks <- filt_df() %>%
pull(ticker)
ret %>%
filter(symbol %in% ticks) %>%
filter(date >= Sys.Date() %m-% years(1)) %>%
group_by(date) %>%
summarize(ret = mean(weekly_return, na.rm = T)) %>%
mutate(c_ret = with_order(date, cumprod, 1 + ret) - 1) %>%
plot_ly(x = ~ date,
y = ~ c_ret * 100) %>%
add_lines()
})
output$screen_tree <- renderHighchart({
filt_df() %>%
mutate(weight = 1) %>%
hctreemap2(
group_vars = c("sector"),
size_var = "weight",
layoutAlgorithm = "squarified",
levels = list(
list(level = 1, dataLabels = list(enabled = TRUE)),
list(level = 2, dataLabels = list(enabled = TRUE))
)
)
})
ret_hot <- reactive({
index_df <- index_df()
ret %>%
filter(symbol %in% index_df$ticker) %>%
filter(date >= input$clust_date %m-% years(2))
})
# Returns
cor_mat <- reactive({
wide_df <- ret_hot() %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
group_by(symbol) %>%
mutate(n = sum(ifelse(
near(weekly_return, 0) | is.na(weekly_return), 0, 1
))) %>%
ungroup() %>%
filter(n >= max(n, na.rm = T) * .9) %>%
select(-n) %>%
spread(symbol, weekly_return) %>%
select(-date) %>%
replace(is.na(.), 0) %>%
.[-1, ]
# Correlation Matrix
cor(wide_df, use = "complete.obs")
})
output$cor_mx <- renderRHandsontable({
# Returns
# ret <- pr %>%
# group_by(symbol) %>%
# tq_transmute(select = adjusted,
# mutate_fun = weeklyReturn,
# col_rename = "weekly_return")
corMat <- cor_mat()
# Spread Returns
# HC
hcg <- as.dist(1 - corMat) %>%
hclust(method = "complete") %>%
cutree(input$clust_cut) %>%
as.list() %>%
as_tibble() %>%
gather(rowname, Group)
by.cluster <- corMat %>%
as.data.frame() %>%
rownames_to_column() %>%
as_tibble() %>%
gather(Ticker, Corv, -rowname) %>%
filter(Corv != 1) %>%
left_join(hcg, by = "rowname") %>%
group_by(Ticker, Group) %>%
summarize(m.cor = mean(Corv, na.rm = T)) %>%
semi_join(hcg, by = c("Ticker" = "rowname", "Group")) %>%
arrange(desc(m.cor))
res <- by.cluster %>%
group_by(Group) %>%
add_tally() %>%
summarize(
group.m = mean(m.cor, na.rm = T),
n = as.integer(median(n)),
rank = group.m * sqrt(n)
) %>%
mutate(rank = min_rank(desc(rank))) %>%
left_join(by.cluster, by = "Group") %>%
select(Ticker, m.cor, everything()) %>%
arrange(rank)
if (is.null(input$clust_tick) | input$clust_tick == "") {
filt_ticks <- res %>% filter(rank == input$clust_rank) %>%
pull(Ticker)
} else{
r <- res %>% filter(Ticker == input$clust_tick) %>% pull(rank)
filt_ticks <- res %>% filter(rank == r) %>%
pull(Ticker)
}
cor_filt <- ret_hot() %>%
filter(symbol %in% filt_ticks) %>%
spread(symbol, weekly_return) %>%
.[-1, ] %>%
select(-date) %>%
cor(use = "complete.obs")
cor_filt %>%
rhandsontable(readOnly = TRUE) %>%
hot_cols(
renderer = "
function (instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.NumericRenderer.apply(this, arguments);
if (row == col) {
td.style.background = 'lightgrey';
} else if (col > row) {
td.style.color = 'grey';
td.style.background = 'grey';
} else if (value < 0) {
td.style.background = '#2166AC66';
} else if (value < 0.2) {
td.style.background = '#67A9CF66';
} else if (value < 0.4) {
td.style.background = '#D1E5F066';
} else if (value < 0.6) {
td.style.background = '#FDDBC766';
} else if (value < 0.8) {
td.style.background = '#EF8A6266';
} else if (value <= 1) {
td.style.background = '#B2182B66';
}
}"
) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
observe({
if (!is.null(input$cor_mx)) {
values$cor_mx <- hot_to_r(input$cor_mx) %>% as_tibble()
}
})
output$ret_filt <- renderPlotly({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
if (input$predict_rets == T) {
filt_d <- input$clust_date
} else {
filt_d <- input$clust_date %m-% years(1)
}
port <- ret %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
filter(symbol %in% clust_ticks_filter) %>%
filter(date >= filt_d) %>%
group_by(date) %>%
summarize(weekly_return = mean(weekly_return, na.rm = T)) %>%
mutate(
cum_ret = with_order(date, cumprod, 1 + weekly_return),
cum_max = with_order(date, cummax, cum_ret),
DD = cum_ret / cum_max - 1,
cum_ret = cum_ret - 1
) %>%
add_column(ticker = "Cluster EW", .before = 1)
# hrp_w <- ret_hot() %>%
# filter(symbol %in% clust_ticks_filter) %>%
# hrp_fun()
#
# hrp <- ret %>%
# filter(symbol %in% clust_ticks_filter) %>%
# filter(date >= input$clust_date[[2]]) %>%
# left_join(hrp_w,by = "symbol") %>%
# mutate(weekly_contr_return = weekly_return * out) %>%
# group_by(date) %>%
# summarize(weekly_return = sum(weekly_contr_return,na.rm = T)) %>%
# mutate(cum_ret = with_order(date,cumprod,1+weekly_return),
# cum_max = with_order(date,cummax,cum_ret),
# DD = cum_ret/cum_max - 1,
# cum_ret = cum_ret-1) %>%
# add_column(ticker = "HRP",.before = 1)
bench <- tq_get("SPY") %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
tq_transmute(select = adjusted,
mutate_fun = weeklyReturn,
col_rename = "weekly_return") %>%
filter(date >= filt_d) %>%
mutate(
cum_ret = with_order(date, cumprod, 1 + weekly_return),
cum_max = with_order(date, cummax, cum_ret),
DD = cum_ret / cum_max - 1,
cum_ret = cum_ret - 1
) %>%
add_column(ticker = "Bench", .before = 1)
plot.df <- port %>% full_join(bench)
perf.c <-
plot.df %>%
plot_ly(
x = ~ date,
y = ~ cum_ret,
color = ~ ticker,
type = "scatter",
mode = "lines",
name = ~ paste(ticker, "Total Return")
) %>%
layout(yaxis = list(tickformat = "%"))
perf.b <- plot.df %>%
plot_ly(
x = ~ date,
y = ~ weekly_return,
color = ~ ticker,
type = "bar",
name = ~ paste(ticker, "Weekly Return")
) %>%
layout(yaxis = list(tickformat = "%"))
perf.dd <- plot.df %>%
plot_ly(
x = ~ date,
y = ~ DD,
color = ~ ticker,
type = "scatter",
mode = "lines",
name = ~ paste(ticker, "Drawdown")
) %>%
layout(yaxis = list(tickformat = "%"))
subplot(perf.c,
perf.b,
perf.dd,
shareX = T,
nrows = 3) %>%
layout(xaxis = list(title = ""))
})
output$clust_screen <- renderRHandsontable({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
filt_df() %>% filter(ticker %in% clust_ticks_filter) %>%
rhandsontable(stretchH = "all") %>%
hot_cols(fixedColumnsLeft = 1) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
output$clust_tree <- renderHighchart({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
index_dt() %>%
filter(Ticker %in% clust_ticks_filter) %>%
rename(weight = "Weight (%)") %>%
hctreemap2(
group_vars = c("Sector", "Ticker"),
size_var = "weight",
layoutAlgorithm = "squarified",
levels = list(
list(level = 1, dataLabels = list(enabled = TRUE)),
list(level = 2, dataLabels = list(enabled = TRUE))
)
)
})
output$clust_returns_dt <- renderText({
clust_ticks_filter <- values$cor_mx %>%
as_tibble() %>%
names()
if (input$predict_rets) {
filt_d <- input$clust_date
} else {
filt_d <- input$clust_date %m-% years(1)
}
clust_port <- ret %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
filter(symbol %in% clust_ticks_filter) %>%
filter(date >= filt_d) %>%
group_by(date) %>%
summarize(weekly_return = mean(weekly_return, na.rm = T)) %>%
select(date, weekly_return)
bench <- tq_get("SPY") %>%
mutate(date = ceiling_date(date, "weeks") - 2) %>%
filter(date != max(date, na.rm = T)) %>%
tq_transmute(select = adjusted,
mutate_fun = weeklyReturn,
col_rename = "weekly_return") %>%
filter(date >= filt_d) %>%
select(date, bench_return = weekly_return)
combined_returns <-
left_join(clust_port, bench, by = c("date" = "date"))
annualized_returns <- clust_port %>%
tq_performance(Ra = weekly_return,
performance_fun = table.AnnualizedReturns) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
downside_risk <- clust_port %>%
tq_performance(Ra = weekly_return,
performance_fun = table.DownsideRisk) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
drawdowns_ratio <- clust_port %>%
tq_performance(Ra = weekly_return,
performance_fun = table.DrawdownsRatio) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
capm <- combined_returns %>%
tq_performance(Ra = weekly_return,
Rb = bench_return,
performance_fun = table.CAPM) %>%
gather(key, value) %>%
slice(1:7) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
information_ratio <- combined_returns %>%
tq_performance(Ra = weekly_return,
Rb = bench_return,
performance_fun = table.InformationRatio) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
specific_risk <- combined_returns %>%
tq_performance(Ra = weekly_return,
Rb = bench_return,
performance_fun = table.SpecificRisk) %>%
gather(key, value) %>%
left_join(performance_labels, by = "key") %>%
select(label, value) %>%
mutate(value = round(value, 2)) %>%
arrange(label)
x <- bind_rows(
annualized_returns,
capm,
downside_risk,
drawdowns_ratio,
information_ratio,
specific_risk
) %>%
kable() %>%
group_rows("Annualized Return Statistics", 1, 3) %>%
group_rows("CAPM", 4, 10) %>%
group_rows("Downside Risk", 11, 21) %>%
group_rows("Drawdown Ratios", 22, 28) %>%
group_rows("Information Ratio", 29, 31) %>%
group_rows("Specific Risk", 32, 34)
gsub("<thead>.*</thead>", "", x)
})
})
)
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.