R/uiElements.R
In lubrunn/DSP_App_Abgabe: What the Package Does (One Line, Title Case)
Defines functions
custom_lag_tab
model_specification_for
model_specification
numeric_features
tabs_custom_xgb
parameter_tabs_xgb
tabs_custom_var
parameter_tabs_var
tabs_custom
parameter_tabs
selectize_Stocks_reg
tabs_custom_gra
parameter_tabs_gra
hover_info_corona
plot_corona
sliderinput_dates_corona
selectize_corona
hover_info_DE
plot_stocks_DE
sliderinput_dates
Documented in
hover_info_corona
hover_info_DE
numeric_features
parameter_tabs
parameter_tabs_var
parameter_tabs_xgb
plot_corona
plot_stocks_DE
selectize_corona
selectize_Stocks_reg
sliderinput_dates
sliderinput_dates_corona
tabs_custom
tabs_custom_var
tabs_custom_xgb
#' UI Elements
#'
#'
##################################################### Stocks
# sliderinput for dates
#' @export
#' @rdname uiElements
sliderinput_dates <- function(){
sliderInput("dates",label="Timeseries",
value = c(as.Date("2020-02-12"),as.Date("2021-02-12")),
min = as.Date("2020-01-02"),
max = as.Date("2021-02-12"),
step = 1,timeFormat = "%F")
}
#plotoutput for german companies
#' @export
#' @rdname uiElements
plot_stocks_DE <- function() {
plotOutput("plot_DE",hover = hoverOpts("plot_hover_DE", delay = 10, delayType = "debounce"),
dblclick = "plot1_dblclick",
brush = brushOpts(id = "plot1_brush",resetOnNew = TRUE))
}
#hoverbox in german plot
#' @export
#' @rdname uiElements
hover_info_DE <- function() {
uiOutput("hover_info_DE",style = "pointer-events: none")
}
################################################################## CORONA
# selectize input for corona
#' @export
#' @rdname uiElements
selectize_corona <- function() {
selectizeInput("corona_measurement","Chose Corona measurement",
# c("total_cases","new_cases","total_deaths","new_deaths","total_cases_per_million",
# "new_cases_per_million","total_deaths_per_million","new_deaths_per_million","reproduction_rate",
# "icu_patients","icu_patients_per_million","hosp_patients","hosp_patients_per_million",
# "weekly_icu_admissions","weekly_icu_admissions_per_million","weekly_hosp_admissions",
# "weekly_hosp_admissions_per_million","new_tests","total_tests","total_tests_per_thousand",
# "new_tests_per_thousand","positive_rate","tests_per_case","total_vaccinations","people_vaccinated",
# "people_fully_vaccinated","new_vaccinations","total_vaccinations_per_hundred","people_vaccinated_per_hundred",
# "people_fully_vaccinated_per_hundred"),
c(
"New Cases per Million" = "new_cases_per_million",
"New Deaths per Million" = "new_deaths_per_million",
"Reproduction Rate" = "reproduction_rate"
),
multiple = FALSE,
selected = "total_deaths")
}
# sliderinput for dates
#' @export
#' @rdname uiElements
sliderinput_dates_corona <- function(){
sliderInput("dates_corona",label="Time",
value = c(as.Date("2020-01-22"),Sys.Date()),
min = as.Date("2020-01-22"),
max = Sys.Date(),
step = 1,timeFormat = "%F")}
#' @export
#' @rdname uiElements
plot_corona <- function() {
plotOutput("corona_plot",hover = hoverOpts("plot_hover_corona", delay = 10, delayType = "debounce"),
dblclick = "plot_corona_dblclick",
brush = brushOpts(id = "plot_corona_brush",resetOnNew = TRUE))
}
#' @export
#' @rdname uiElements
hover_info_corona <- function() {
uiOutput("hover_info_corona",style = "pointer-events: none")
}
#################################################################################################################### Granger
# #' @export
# #' @rdname uiElements
# parameter_tabsi_gra <- function(){
# tabsetPanel(
# id = "industry_tab_gra",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1_gra","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1_gra", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1_gra", "clear selected"),
# radioButtons("minRetweet_stocks1_gra", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1_gra","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry_gra", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2_gra","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2_gra", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2_gra", "clear selected"),
# radioButtons("minRetweet_stocks2_gra", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2_gra","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
# }
#' @export
#' @rdname uiElements
parameter_tabs_gra <- function(){
tabsetPanel(
id = "params_gra",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_granger","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language_gra", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation_gra", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets_gra", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes_gra", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length_gra",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment_gra","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi_gra()
#
# )
)
}
#' @export
#' @rdname uiElements
tabs_custom_gra <- function(){
tabsetPanel(
id = "regression_tabs_gra",
tabPanel("Model specifcation",
tags$hr(),
actionButton("instructions_granger", "Instructions"),
div(id="first_variable_granger",
tags$h4("Choose first variable:"),
shinyWidgets::radioGroupButtons("country_granger","Which country?",choices=c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select country for the company selection. Only refers to the first variable."),
size = "s"),
uiOutput("Stock_Granger"),
shinyWidgets::radioGroupButtons("Granger_outcome","variable:",choices=c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")),
tags$hr(),
div(id="second_variable_granger",
tags$h4("Choose second variable:"),
switchInput("senti_yesno_gra","Include Sentiment?",onLabel="Yes",offLabel="No"),
textOutput("gra_con_check"),
tags$head(tags$style("#gra_con_check{color: red;}")),
uiOutput("ControlsGranger"),
selectize_corona_granger()),
tags$hr(),
textOutput("gra_date_check"),
tags$head(tags$style("#gra_date_check{color: red;}")),
div(id="date_variable_granger",
sliderInput("date_granger",label="Choose timeseries:",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")),
div(id="direction_variable_granger",
checkboxInput("direction_granger","Second variable causes first?",value = TRUE)%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select the direction of causation. If checked, the second variable granger causes the first one."),
size = "s"))
),
tabPanel("Filter sentiment input",
#selectInput("Sentiment_type_gra", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs_gra()
)
)
}
################################################################## Regression
# selectize input for companies
#' @export
#' @rdname uiElements
selectize_Stocks_reg <- function() {
#full_components <- rbind(components1,components2)
selectInput("Stock_reg","Chose Company",
c("Covestro ","adidas ","Allianz ","BASF ","Bayer ","Beiersdorf ","Bayerische Motoren Werke ",
"Continental ","Daimler ","Deutsche Börse ","Deutsche Bank ","Delivery Hero ","Deutsche Post ",
"Deutsche Telekom ","Deutsche Wohnen ","EON ","Fresenius Medical Care ","Fresenius ","HeidelbergCement ",
"Henkel ","Infineon Technologies ","Linde ","MERCK ","MULTI-UNITS LUXEMBOURG - Lyxor Euro Government Bond (DR) UCITS ETF - Acc ",
"Münchener Rückversicherungs-Gesellschaft ","RWE ","SAP ","Siemens ","Vonovia ","Volkswagen ",
"Apple ","Amgen ","American Express Company ","The Boeing Company ","Caterpillar ","salesforcecom ",
"Cisco Systems ","Chevron Corporation ","The Walt Disney Company ","Dow ",
"The Goldman Sachs Group ","The Home Depot ","Honeywell International ","International Business Machines Corporation ",
"Intel Corporation ","Johnson Johnson ","JPMorgan Chase ","The Coca-Cola Company ","McDonald's Corporation ",
"3M Company ","Merck ","Microsoft Corporation ","NIKE ","The Procter Gamble Company ","The Travelers Companies ","UnitedHealth Group Incorporated ",
"Visa ","Verizon Communications ","Walgreens Boots Alliance ","Walmart")
,selected = "adidas ")
}
# #' @export
# #' @rdname uiElements
# parameter_tabsi <- function(){
# tabsetPanel(
# id = "industry_tab",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1", "clear selected"),
# radioButtons("minRetweet_stocks1", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2", "clear selected"),
# radioButtons("minRetweet_stocks2", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
# }
#' @export
#' @rdname uiElements
parameter_tabs <- function(){
tabsetPanel(
id = "params",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_regression","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi()
#
#)
)
}
#' @export
#' @rdname uiElements
tabs_custom <- function(){
tabsetPanel(
id = "regression_tabs",
tabPanel("Model specifcation",
tags$hr(),
actionButton("instructions_regression", "Instructions"),
div(id="first_variable_regression",
tags$h4("Choose dependent variable:"),
shinyWidgets::radioGroupButtons("country_regression","Which country?",choices=c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select country for the company selection. Only refers to the dependent variable."),
size = "s"),
uiOutput("stock_regression"),
shinyWidgets::radioGroupButtons("regression_outcome","variable:",choices=c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")),
tags$hr(),
div(id="control_variable_regression",
tags$h4("Choose control variables:"),
switchInput("senti_yesno_reg","Include Sentiment?",onLabel="Yes",offLabel="No"),
textOutput("reg_con_check"),
tags$head(tags$style("#reg_con_check{color: red;}")),
uiOutput("Controls"),
selectize_corona_regression(),
actionButton("reset_regression", "clear selected")),
#radioButtons("Granger_outcome","Which variable?",c("Open","High","Low","Close","Adj.Close","Volume"),selected = "Close"),
#selectizeInput("Sentiment_Granger","Choose second argument: Sentiment",choices="under construction"),
tags$hr(),
conditionalPanel(
condition = "input.regressiontabs==1",
numericInput("Quantiles","Choose quantile",value=0.5,min=0.05,max=0.95,step = 0.05)),
textOutput("reg_date_check"),
tags$head(tags$style("#reg_date_check{color: red;}")),
div(id="date_variable_regression",
sliderInput("date_regression",label = "Choose timeseries",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")),
),
tabPanel("Filter sentiment input",
#selectInput("Sentiment_type", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs()
)
)
}
################################################################ VAR
# #' @export
# #' @rdname uiElements
# parameter_tabsi_var <- function(){
# tabsetPanel(
# id = "industry_tab_var",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1_var","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1_var", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1_var", "clear selected"),
# radioButtons("minRetweet_stocks1_var", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1_var","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry_var", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2_var","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2_var", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2_var", "clear selected"),
# radioButtons("minRetweet_stocks2_var", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2_var","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
# }
#' @export
#' @rdname uiElements
parameter_tabs_var <- function(){
tabsetPanel(
id = "params_var",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_var","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language_var", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation_var", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets_var", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes_var", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length_var",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment_gra","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi_gra()
#
# )
)
}
#' @export
#' @rdname uiElements
tabs_custom_var <- function(){
tabsetPanel(
id = "regression_tabs_var",
tabPanel("Model specifcation",
tags$hr(),
actionButton("instructions_var", "Instructions"),
div(id="first_variable_var",
tags$h4("Choose dependent variable:"),
shinyWidgets::radioGroupButtons("country_regression_var","Which country?",choices=c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select country for the company selection. Only refers to the dependent variable."),
size = "s"),
uiOutput("stock_regression_var"),
shinyWidgets::radioGroupButtons("regression_outcome_var","variable:",c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")),
tags$hr(),
div(id="control_variable_var",
tags$h4("Choose control variables:"),
switchInput("senti_yesno_var","Include Sentiment?",onLabel="Yes",offLabel="No"),
textOutput("var_con_check"),
tags$head(tags$style("#var_con_check{color: red;}")),
uiOutput("Controls_var"),
selectize_corona_var(),
actionButton("reset_regression_var", "clear selected")),
tags$hr(),
textOutput("var_date_check"),
tags$head(tags$style("#var_date_check{color: red;}")),
div(id="date_variable_var",
sliderInput("date_regression_var",label = "Timeseries",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")),
div(id="forecast_var",
numericInput("ahead", "choose how many days to forecast", value = 5, min = 1, max = 100)),
conditionalPanel(
condition = "input.vartabs==1",
selectInput("var_which_plot","Select plot to show:",c("Forecasted period only","Full time series"),selected="Forecasted period only"))
),
tabPanel("Filter sentiment input",
# selectInput("Sentiment_type_var", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs_var()
)
)
}
##################################################### Xgboost
# #' @export
# #' @rdname uiElements
# parameter_tabsi_xgb <- function(){
# tabsetPanel(
# id = "industry_tab_xgb",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1_xgb","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1_xgb", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1_xgb", "clear selected"),
# radioButtons("minRetweet_stocks1_xgb", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1_xgb","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry_xgb", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2_xgb","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2_xgb", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2_xgb", "clear selected"),
# radioButtons("minRetweet_stocks2_xgb", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2_xgb","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
#
# }
#' @export
#' @rdname uiElements
parameter_tabs_xgb <- function(){
tabsetPanel(
id = "params_xgb",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_xgb","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language_xgb", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation_xgb", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets_xgb", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes_xgb", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length_xgb",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment_gra","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi_gra()
#
# )
)
}
#' @export
#' @rdname uiElements
tabs_custom_xgb <- function(){
tabsetPanel(
id = "regression_tabs_xgb",
tabPanel("Model specifcation",
tags$h4("Choose dependent variable:"),
shinyWidgets::radioGroupButtons("country_regression_xgb","Which country?",c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm"),
uiOutput("stock_regression_xgb"),
shinyWidgets::radioGroupButtons("regression_outcome_xgb","variable:",c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm"),
tags$hr(),
tags$h4("Choose control variables:"),
switchInput("senti_yesno_xgb","Include Sentiment?",onLabel="Yes",offLabel="No"),
uiOutput("Controls_xgb"),
#uiOutput("corona_vars_xgb"),
selectize_corona_xgb(),
#radioButtons("country_corona_xgb","country of corona variable?",c("Germany","United States"),selected = "Germany"),
actionButton("reset_regression_xgb", "clear selected"),
#radioButtons("Granger_outcome","Which variable?",c("Open","High","Low","Close","Adj.Close","Volume"),selected = "Close"),
#selectizeInput("Sentiment_Granger","Choose second argument: Sentiment",choices="under construction"),
tags$hr(),
textOutput("xgb_date_check"),
tags$head(tags$style("#xgb_date_check{color: red;}")),
sliderInput("date_regression_xgb",label = "Timeseries",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")
),
tabPanel("Filter sentiment input",
#selectInput("Sentiment_type_xgb", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs_xgb()
)
)
}
#' @export
#' @rdname uiElements
numeric_features <- function(){
tabsetPanel(
id = "tabs_for_xgb",
type = "hidden",
tabPanel("1",
tags$h4("Choose additional features:"),
#selectInput("var_1", "Chose variable to add AR and/or MA features", choices = ""),
uiOutput("add_features"),
textInput("ma_select", "Select list/value of moving averages" ,placeholder = "e.g. 10,20,100,..."),
textInput("ma_select2", "Select list/value of exponential moving averages", placeholder = "e.g. 10,20,100,..."),
#radioButtons("ma_type","Select a type of moving average", choices = c("mean","exponential")),
#numericInput("num_1","Chose length of moving average",min=0,value = 2),
numericInput("num_2","Chose Autoregressive lags for",min=0,value = 1),
#radioButtons("corona_dummy","1st lockdown dummy",choices = c("yes","no")),
actionButton("addButton", "Upload"),
uiOutput("finish_button"),
actionButton("reset_cus", "Reset")
)
# tabPanel("2",
# selectInput("var_2", "Select varaible", choices = ""), #could I use var_1 here?
# numericInput("num_3","Chose length of moving average",min=1,value = 1),
# numericInput("num_4","Chose Autoregressive lags for",min=1,value = 1),
# selectInput("var_3", "Select varaible", choices = ""),
# numericInput("num_5","Chose length of moving average",min=1,value = 1),
# numericInput("num_6","Chose Autoregressive lags for",min=1,value = 1)
# )
)
}
model_specification <- function(){
tabsetPanel(
id = "mod_spec",
type = "hidden",
tabPanel("default"),
tabPanel("custom",
numericInput("mtry","number of predictors that will be randomly sampled",min = 2,max=30,step = 1,value = 20),
numericInput("trees","number of trees contained in the ensemble",min = 50,max=1000,step = 10,value = 200),
numericInput("min_n","minimum number of data points in a node",min = 1,max=20,step = 1,value = 3),
numericInput("tree_depth","maximum depth of the tree",min = 1,max=50,step = 1,value = 8),
numericInput("learn_rate","rate at which the boosting algorithm adapts",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("loss_reduction","reduction in the loss function required to split further",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("sample_size","amount of data exposed to the fitting routine",min = 0.1,max=1,step = 0.1,value = 0.7)
),
tabPanel("hyperparameter_tuning",
numericInput("trees_hyp","number of predictors that will be randomly sampled",min = 50,max=1000,step = 10,value = 200),
numericInput("grid_size","size of tuning grid",min = 10,max=100,step = 5,value = 30)
)
)
}
model_specification_for <- function(){
tabsetPanel(
id = "mod_spec_for",
type = "hidden",
tabPanel("default"),
tabPanel("custom",
numericInput("mtry1","number of predictors that will be randomly sampled",min = 2,max=30,step = 1,value = 20),
numericInput("trees1","number of trees contained in the ensemble",min = 50,max=1000,step = 10,value = 200),
numericInput("min_n1","minimum number of data points in a node",min = 1,max=20,step = 1,value = 3),
numericInput("tree_depth1","maximum depth of the tree",min = 1,max=50,step = 1,value = 8),
numericInput("learn_rate1","rate at which the boosting algorithm adapts",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("loss_reduction1","reduction in the loss function required to split further",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("sample_size1","amount of data exposed to the fitting routine",min = 0.1,max=1,step = 0.1,value = 0.7)
),
tabPanel("hyperparameter_tuning",
numericInput("trees_hyp1","number of predictors that will be randomly sampled",min = 50,max=1000,step = 10,value = 200),
numericInput("grid_size1","size of tuning grid",min = 10,max=100,step = 5,value = 30)
)
)
}
custom_lag_tab <- function(){
tabsetPanel(
id = "lag_tab",
type = "hidden",
tabPanel("default"),
tabPanel("custom",
tags$br(),
tags$hr(),
tags$h4("Inspect autocorrelation:"),
selectInput("correlation_type", "Chose type of correlation plot:", choices = c("ACF","PACF"), selected = ""),
uiOutput("correlation_plot_choice"),
tags$br(),
numeric_features()
# actionButton("reset_arma", "clear selected")
)
)
}
lubrunn/DSP_App_Abgabe documentation built on Dec. 21, 2021, 11:51 a.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.
Defines functions custom_lag_tab model_specification_for model_specification numeric_features tabs_custom_xgb parameter_tabs_xgb tabs_custom_var parameter_tabs_var tabs_custom parameter_tabs selectize_Stocks_reg tabs_custom_gra parameter_tabs_gra hover_info_corona plot_corona sliderinput_dates_corona selectize_corona hover_info_DE plot_stocks_DE sliderinput_dates
Documented in hover_info_corona hover_info_DE numeric_features parameter_tabs parameter_tabs_var parameter_tabs_xgb plot_corona plot_stocks_DE selectize_corona selectize_Stocks_reg sliderinput_dates sliderinput_dates_corona tabs_custom tabs_custom_var tabs_custom_xgb
#' UI Elements
#'
#'
##################################################### Stocks
# sliderinput for dates
#' @export
#' @rdname uiElements
sliderinput_dates <- function(){
sliderInput("dates",label="Timeseries",
value = c(as.Date("2020-02-12"),as.Date("2021-02-12")),
min = as.Date("2020-01-02"),
max = as.Date("2021-02-12"),
step = 1,timeFormat = "%F")
}
#plotoutput for german companies
#' @export
#' @rdname uiElements
plot_stocks_DE <- function() {
plotOutput("plot_DE",hover = hoverOpts("plot_hover_DE", delay = 10, delayType = "debounce"),
dblclick = "plot1_dblclick",
brush = brushOpts(id = "plot1_brush",resetOnNew = TRUE))
}
#hoverbox in german plot
#' @export
#' @rdname uiElements
hover_info_DE <- function() {
uiOutput("hover_info_DE",style = "pointer-events: none")
}
################################################################## CORONA
# selectize input for corona
#' @export
#' @rdname uiElements
selectize_corona <- function() {
selectizeInput("corona_measurement","Chose Corona measurement",
# c("total_cases","new_cases","total_deaths","new_deaths","total_cases_per_million",
# "new_cases_per_million","total_deaths_per_million","new_deaths_per_million","reproduction_rate",
# "icu_patients","icu_patients_per_million","hosp_patients","hosp_patients_per_million",
# "weekly_icu_admissions","weekly_icu_admissions_per_million","weekly_hosp_admissions",
# "weekly_hosp_admissions_per_million","new_tests","total_tests","total_tests_per_thousand",
# "new_tests_per_thousand","positive_rate","tests_per_case","total_vaccinations","people_vaccinated",
# "people_fully_vaccinated","new_vaccinations","total_vaccinations_per_hundred","people_vaccinated_per_hundred",
# "people_fully_vaccinated_per_hundred"),
c(
"New Cases per Million" = "new_cases_per_million",
"New Deaths per Million" = "new_deaths_per_million",
"Reproduction Rate" = "reproduction_rate"
),
multiple = FALSE,
selected = "total_deaths")
}
# sliderinput for dates
#' @export
#' @rdname uiElements
sliderinput_dates_corona <- function(){
sliderInput("dates_corona",label="Time",
value = c(as.Date("2020-01-22"),Sys.Date()),
min = as.Date("2020-01-22"),
max = Sys.Date(),
step = 1,timeFormat = "%F")}
#' @export
#' @rdname uiElements
plot_corona <- function() {
plotOutput("corona_plot",hover = hoverOpts("plot_hover_corona", delay = 10, delayType = "debounce"),
dblclick = "plot_corona_dblclick",
brush = brushOpts(id = "plot_corona_brush",resetOnNew = TRUE))
}
#' @export
#' @rdname uiElements
hover_info_corona <- function() {
uiOutput("hover_info_corona",style = "pointer-events: none")
}
#################################################################################################################### Granger
# #' @export
# #' @rdname uiElements
# parameter_tabsi_gra <- function(){
# tabsetPanel(
# id = "industry_tab_gra",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1_gra","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1_gra", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1_gra", "clear selected"),
# radioButtons("minRetweet_stocks1_gra", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1_gra","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry_gra", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2_gra","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2_gra", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2_gra", "clear selected"),
# radioButtons("minRetweet_stocks2_gra", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2_gra","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
# }
#' @export
#' @rdname uiElements
parameter_tabs_gra <- function(){
tabsetPanel(
id = "params_gra",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_granger","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language_gra", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation_gra", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets_gra", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes_gra", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length_gra",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment_gra","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi_gra()
#
# )
)
}
#' @export
#' @rdname uiElements
tabs_custom_gra <- function(){
tabsetPanel(
id = "regression_tabs_gra",
tabPanel("Model specifcation",
tags$hr(),
actionButton("instructions_granger", "Instructions"),
div(id="first_variable_granger",
tags$h4("Choose first variable:"),
shinyWidgets::radioGroupButtons("country_granger","Which country?",choices=c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select country for the company selection. Only refers to the first variable."),
size = "s"),
uiOutput("Stock_Granger"),
shinyWidgets::radioGroupButtons("Granger_outcome","variable:",choices=c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")),
tags$hr(),
div(id="second_variable_granger",
tags$h4("Choose second variable:"),
switchInput("senti_yesno_gra","Include Sentiment?",onLabel="Yes",offLabel="No"),
textOutput("gra_con_check"),
tags$head(tags$style("#gra_con_check{color: red;}")),
uiOutput("ControlsGranger"),
selectize_corona_granger()),
tags$hr(),
textOutput("gra_date_check"),
tags$head(tags$style("#gra_date_check{color: red;}")),
div(id="date_variable_granger",
sliderInput("date_granger",label="Choose timeseries:",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")),
div(id="direction_variable_granger",
checkboxInput("direction_granger","Second variable causes first?",value = TRUE)%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select the direction of causation. If checked, the second variable granger causes the first one."),
size = "s"))
),
tabPanel("Filter sentiment input",
#selectInput("Sentiment_type_gra", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs_gra()
)
)
}
################################################################## Regression
# selectize input for companies
#' @export
#' @rdname uiElements
selectize_Stocks_reg <- function() {
#full_components <- rbind(components1,components2)
selectInput("Stock_reg","Chose Company",
c("Covestro ","adidas ","Allianz ","BASF ","Bayer ","Beiersdorf ","Bayerische Motoren Werke ",
"Continental ","Daimler ","Deutsche Börse ","Deutsche Bank ","Delivery Hero ","Deutsche Post ",
"Deutsche Telekom ","Deutsche Wohnen ","EON ","Fresenius Medical Care ","Fresenius ","HeidelbergCement ",
"Henkel ","Infineon Technologies ","Linde ","MERCK ","MULTI-UNITS LUXEMBOURG - Lyxor Euro Government Bond (DR) UCITS ETF - Acc ",
"Münchener Rückversicherungs-Gesellschaft ","RWE ","SAP ","Siemens ","Vonovia ","Volkswagen ",
"Apple ","Amgen ","American Express Company ","The Boeing Company ","Caterpillar ","salesforcecom ",
"Cisco Systems ","Chevron Corporation ","The Walt Disney Company ","Dow ",
"The Goldman Sachs Group ","The Home Depot ","Honeywell International ","International Business Machines Corporation ",
"Intel Corporation ","Johnson Johnson ","JPMorgan Chase ","The Coca-Cola Company ","McDonald's Corporation ",
"3M Company ","Merck ","Microsoft Corporation ","NIKE ","The Procter Gamble Company ","The Travelers Companies ","UnitedHealth Group Incorporated ",
"Visa ","Verizon Communications ","Walgreens Boots Alliance ","Walmart")
,selected = "adidas ")
}
# #' @export
# #' @rdname uiElements
# parameter_tabsi <- function(){
# tabsetPanel(
# id = "industry_tab",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1", "clear selected"),
# radioButtons("minRetweet_stocks1", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2", "clear selected"),
# radioButtons("minRetweet_stocks2", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
# }
#' @export
#' @rdname uiElements
parameter_tabs <- function(){
tabsetPanel(
id = "params",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_regression","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi()
#
#)
)
}
#' @export
#' @rdname uiElements
tabs_custom <- function(){
tabsetPanel(
id = "regression_tabs",
tabPanel("Model specifcation",
tags$hr(),
actionButton("instructions_regression", "Instructions"),
div(id="first_variable_regression",
tags$h4("Choose dependent variable:"),
shinyWidgets::radioGroupButtons("country_regression","Which country?",choices=c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select country for the company selection. Only refers to the dependent variable."),
size = "s"),
uiOutput("stock_regression"),
shinyWidgets::radioGroupButtons("regression_outcome","variable:",choices=c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")),
tags$hr(),
div(id="control_variable_regression",
tags$h4("Choose control variables:"),
switchInput("senti_yesno_reg","Include Sentiment?",onLabel="Yes",offLabel="No"),
textOutput("reg_con_check"),
tags$head(tags$style("#reg_con_check{color: red;}")),
uiOutput("Controls"),
selectize_corona_regression(),
actionButton("reset_regression", "clear selected")),
#radioButtons("Granger_outcome","Which variable?",c("Open","High","Low","Close","Adj.Close","Volume"),selected = "Close"),
#selectizeInput("Sentiment_Granger","Choose second argument: Sentiment",choices="under construction"),
tags$hr(),
conditionalPanel(
condition = "input.regressiontabs==1",
numericInput("Quantiles","Choose quantile",value=0.5,min=0.05,max=0.95,step = 0.05)),
textOutput("reg_date_check"),
tags$head(tags$style("#reg_date_check{color: red;}")),
div(id="date_variable_regression",
sliderInput("date_regression",label = "Choose timeseries",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")),
),
tabPanel("Filter sentiment input",
#selectInput("Sentiment_type", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs()
)
)
}
################################################################ VAR
# #' @export
# #' @rdname uiElements
# parameter_tabsi_var <- function(){
# tabsetPanel(
# id = "industry_tab_var",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1_var","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1_var", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1_var", "clear selected"),
# radioButtons("minRetweet_stocks1_var", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1_var","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry_var", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2_var","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2_var", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2_var", "clear selected"),
# radioButtons("minRetweet_stocks2_var", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2_var","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
# }
#' @export
#' @rdname uiElements
parameter_tabs_var <- function(){
tabsetPanel(
id = "params_var",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_var","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language_var", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation_var", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets_var", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes_var", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length_var",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment_gra","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi_gra()
#
# )
)
}
#' @export
#' @rdname uiElements
tabs_custom_var <- function(){
tabsetPanel(
id = "regression_tabs_var",
tabPanel("Model specifcation",
tags$hr(),
actionButton("instructions_var", "Instructions"),
div(id="first_variable_var",
tags$h4("Choose dependent variable:"),
shinyWidgets::radioGroupButtons("country_regression_var","Which country?",choices=c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")%>% shinyhelper::helper(type = "inline",
title = "",
content = c("Select country for the company selection. Only refers to the dependent variable."),
size = "s"),
uiOutput("stock_regression_var"),
shinyWidgets::radioGroupButtons("regression_outcome_var","variable:",c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm")),
tags$hr(),
div(id="control_variable_var",
tags$h4("Choose control variables:"),
switchInput("senti_yesno_var","Include Sentiment?",onLabel="Yes",offLabel="No"),
textOutput("var_con_check"),
tags$head(tags$style("#var_con_check{color: red;}")),
uiOutput("Controls_var"),
selectize_corona_var(),
actionButton("reset_regression_var", "clear selected")),
tags$hr(),
textOutput("var_date_check"),
tags$head(tags$style("#var_date_check{color: red;}")),
div(id="date_variable_var",
sliderInput("date_regression_var",label = "Timeseries",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")),
div(id="forecast_var",
numericInput("ahead", "choose how many days to forecast", value = 5, min = 1, max = 100)),
conditionalPanel(
condition = "input.vartabs==1",
selectInput("var_which_plot","Select plot to show:",c("Forecasted period only","Full time series"),selected="Forecasted period only"))
),
tabPanel("Filter sentiment input",
# selectInput("Sentiment_type_var", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs_var()
)
)
}
##################################################### Xgboost
# #' @export
# #' @rdname uiElements
# parameter_tabsi_xgb <- function(){
# tabsetPanel(
# id = "industry_tab_xgb",
# type = "hidden",
# tabPanel("no",
# selectize_Stocks_reg(),
# radioButtons("language1_xgb","Language of tweets ?",
# choices = c("en","de"),inline=T),
# selectizeInput("aggregation1_xgb", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset1_xgb", "clear selected"),
# radioButtons("minRetweet_stocks1_xgb", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock1_xgb","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
#
# ),
# tabPanel("yes",
# selectInput("industry_xgb", "Industry", choices = c("Consumer Cyclical","Financial Services")),
#
# radioButtons("language2_xgb","Language of tweets ?",
# choices = c("en","de"),inline=T),
#
# selectizeInput("aggregation2_xgb", "Aggregation", choices = c("Mean","Mean weighted by retweets",
# "Mean weighted by likes", "Mean weighted by length"),
# select = "Mean"),
# actionButton("reset2_xgb", "clear selected"),
# radioButtons("minRetweet_stocks2_xgb", "Select minimum number of retweets:", choices = c("0","10","50","100","200"),inline=T),
# radioButtons("tweet_length_stock2_xgb","Tweet larger than median length:",
# choices = c("yes","no"),selected = "no",inline=T)
#
# )
#
# )
#
# }
#' @export
#' @rdname uiElements
parameter_tabs_xgb <- function(){
tabsetPanel(
id = "params_xgb",
type = "hidden",
tabPanel("NoFilter",
#### select company
selectInput("sentiment_company_xgb","Choose tweets",
company_terms,
selected = "NoFilter"),
###### langauge of tweets selector
shinyWidgets::radioGroupButtons("language_xgb", "Language of tweets",
choices = c("English" = "EN",
"German" = "DE"),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "sm"),
selectizeInput("aggregation_xgb", "Aggregation", choices = c("Mean" = "mean_sentiment",
"Mean weighted by retweets" = "mean_sentiment_rt",
"Mean weighted by likes" = "mean_sentiment_likes",
"Mean weighted by length" = "mean_sentiment_length"),
select = "mean_sentiment"),
shinyWidgets::radioGroupButtons("minRetweets_xgb", "Minimum tweets",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of retweets
a tweet needs to have"),
size = "s"),
####### minimum likes
shinyWidgets::radioGroupButtons("minLikes_xgb", "Minimum Likes",
choices = c(0, 10, 50, 100, 200),
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon")),
size = "xs") %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Choose the minimum number of likes
a tweet needs to have"),
size = "s"),
shinyWidgets::materialSwitch(inputId = "tweet_length_xgb",
label = "Long Tweets only?", value = F) %>%
shinyhelper::helper(type = "inline",
title = "",
content = c("Long Tweets are tweets that contain more
than 80 characters"),
size = "s")
)#,
# tabPanel("Stocks",
# radioButtons("industry_sentiment_gra","Sentiment by industry ?",
# choices = c("yes","no"),selected = "no",inline=T),
# parameter_tabsi_gra()
#
# )
)
}
#' @export
#' @rdname uiElements
tabs_custom_xgb <- function(){
tabsetPanel(
id = "regression_tabs_xgb",
tabPanel("Model specifcation",
tags$h4("Choose dependent variable:"),
shinyWidgets::radioGroupButtons("country_regression_xgb","Which country?",c("Germany","USA"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm"),
uiOutput("stock_regression_xgb"),
shinyWidgets::radioGroupButtons("regression_outcome_xgb","variable:",c("Adjusted Close"="Adj.Close","Return"="Return","log Adj. Close"="log_Close"),
status = "primary",checkIcon = list(yes = icon("ok",lib = "glyphicon"),
no = icon("remove",lib = "glyphicon")),size = "sm"),
tags$hr(),
tags$h4("Choose control variables:"),
switchInput("senti_yesno_xgb","Include Sentiment?",onLabel="Yes",offLabel="No"),
uiOutput("Controls_xgb"),
#uiOutput("corona_vars_xgb"),
selectize_corona_xgb(),
#radioButtons("country_corona_xgb","country of corona variable?",c("Germany","United States"),selected = "Germany"),
actionButton("reset_regression_xgb", "clear selected"),
#radioButtons("Granger_outcome","Which variable?",c("Open","High","Low","Close","Adj.Close","Volume"),selected = "Close"),
#selectizeInput("Sentiment_Granger","Choose second argument: Sentiment",choices="under construction"),
tags$hr(),
textOutput("xgb_date_check"),
tags$head(tags$style("#xgb_date_check{color: red;}")),
sliderInput("date_regression_xgb",label = "Timeseries",
value = c(as.Date("2018-11-30"),as.Date(date_avail)),
min = as.Date("2018-11-30"),
max = as.Date(date_avail),
step = 1,timeFormat = "%F")
),
tabPanel("Filter sentiment input",
#selectInput("Sentiment_type_xgb", "Type of Sentiment:", choices = c("NoFilter","Stocks"),
# selected = "NoFilter"),
parameter_tabs_xgb()
)
)
}
#' @export
#' @rdname uiElements
numeric_features <- function(){
tabsetPanel(
id = "tabs_for_xgb",
type = "hidden",
tabPanel("1",
tags$h4("Choose additional features:"),
#selectInput("var_1", "Chose variable to add AR and/or MA features", choices = ""),
uiOutput("add_features"),
textInput("ma_select", "Select list/value of moving averages" ,placeholder = "e.g. 10,20,100,..."),
textInput("ma_select2", "Select list/value of exponential moving averages", placeholder = "e.g. 10,20,100,..."),
#radioButtons("ma_type","Select a type of moving average", choices = c("mean","exponential")),
#numericInput("num_1","Chose length of moving average",min=0,value = 2),
numericInput("num_2","Chose Autoregressive lags for",min=0,value = 1),
#radioButtons("corona_dummy","1st lockdown dummy",choices = c("yes","no")),
actionButton("addButton", "Upload"),
uiOutput("finish_button"),
actionButton("reset_cus", "Reset")
)
# tabPanel("2",
# selectInput("var_2", "Select varaible", choices = ""), #could I use var_1 here?
# numericInput("num_3","Chose length of moving average",min=1,value = 1),
# numericInput("num_4","Chose Autoregressive lags for",min=1,value = 1),
# selectInput("var_3", "Select varaible", choices = ""),
# numericInput("num_5","Chose length of moving average",min=1,value = 1),
# numericInput("num_6","Chose Autoregressive lags for",min=1,value = 1)
# )
)
}
model_specification <- function(){
tabsetPanel(
id = "mod_spec",
type = "hidden",
tabPanel("default"),
tabPanel("custom",
numericInput("mtry","number of predictors that will be randomly sampled",min = 2,max=30,step = 1,value = 20),
numericInput("trees","number of trees contained in the ensemble",min = 50,max=1000,step = 10,value = 200),
numericInput("min_n","minimum number of data points in a node",min = 1,max=20,step = 1,value = 3),
numericInput("tree_depth","maximum depth of the tree",min = 1,max=50,step = 1,value = 8),
numericInput("learn_rate","rate at which the boosting algorithm adapts",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("loss_reduction","reduction in the loss function required to split further",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("sample_size","amount of data exposed to the fitting routine",min = 0.1,max=1,step = 0.1,value = 0.7)
),
tabPanel("hyperparameter_tuning",
numericInput("trees_hyp","number of predictors that will be randomly sampled",min = 50,max=1000,step = 10,value = 200),
numericInput("grid_size","size of tuning grid",min = 10,max=100,step = 5,value = 30)
)
)
}
model_specification_for <- function(){
tabsetPanel(
id = "mod_spec_for",
type = "hidden",
tabPanel("default"),
tabPanel("custom",
numericInput("mtry1","number of predictors that will be randomly sampled",min = 2,max=30,step = 1,value = 20),
numericInput("trees1","number of trees contained in the ensemble",min = 50,max=1000,step = 10,value = 200),
numericInput("min_n1","minimum number of data points in a node",min = 1,max=20,step = 1,value = 3),
numericInput("tree_depth1","maximum depth of the tree",min = 1,max=50,step = 1,value = 8),
numericInput("learn_rate1","rate at which the boosting algorithm adapts",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("loss_reduction1","reduction in the loss function required to split further",min = 0.005,max=0.1,step = 0.001,value = 0.01),
numericInput("sample_size1","amount of data exposed to the fitting routine",min = 0.1,max=1,step = 0.1,value = 0.7)
),
tabPanel("hyperparameter_tuning",
numericInput("trees_hyp1","number of predictors that will be randomly sampled",min = 50,max=1000,step = 10,value = 200),
numericInput("grid_size1","size of tuning grid",min = 10,max=100,step = 5,value = 30)
)
)
}
custom_lag_tab <- function(){
tabsetPanel(
id = "lag_tab",
type = "hidden",
tabPanel("default"),
tabPanel("custom",
tags$br(),
tags$hr(),
tags$h4("Inspect autocorrelation:"),
selectInput("correlation_type", "Chose type of correlation plot:", choices = c("ACF","PACF"), selected = ""),
uiOutput("correlation_plot_choice"),
tags$br(),
numeric_features()
# actionButton("reset_arma", "clear selected")
)
)
}
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.