# Set Title
ui_Title <-
h3(headerPanel("Histogram of Continuous Factor"))
# Set Sidebar
ui_Sidebar <-
sidebarPanel(
# Factor
selectInput("Items1",
label = "Select Factor",
choices = item_fct_name,
selected = item_fct_name[1],
multiple = TRUE,
selectize = FALSE),
# Aggregate Type
radioButtons("Type",
label = "Select Aggregation Type",
choices = list("Period" = 1,
"Pooled" = 2),
selected = 1),
# Period
selectInput("Period",
label = "Select Period",
choices = item_date,
selected = tail(item_date, 1),
multiple = TRUE,
selectize = FALSE),
# bins
numericInput("Bins",
label = "Input Bins between 5 and 100",
value = 30,
min = 5,
max = 100),
# show Another Factor
radioButtons("Another",
label = "Show Another Factor",
choices = list("No" = 0,
"Yes" = 1),
selected = 0),
# Another Factor
selectInput("Items2",
label = "Select Another Factor",
choices = item_fct_name,
selected = item_fct_name[1],
multiple = TRUE,
selectize = FALSE)
)
# Set Body
ui_Body <-
mainPanel(
plotOutput("Hist", height = "600px"),
verbatimTextOutput("Sumamry")
)
# Create UI
pageWithSidebar(ui_Title,
ui_Sidebar,
ui_Body)function(input, output, session) {
# Set Reactive
selectedData <- reactive({
X %>%
dplyr::filter(FctName == input$Items1 |
FctName == input$Items2) %>% {
switch(input$Type,
"1" = dplyr::filter(., Period == input$Period),
"2" = select(., everything())
)
} %>% {
switch(input$Another,
"0" = dplyr::filter(., FctName == input$Items1),
"1" = select(., everything())
)
} %>% {
switch(ifelse(input$Items1 != input$Items2, "1", "0"),
"0" = dplyr::filter(., FctName == input$Items1),
"1" = select(., everything())
)
} %>%
group_by(Period, FctName) %>%
mutate(FctVal_S = rescale(FctVal)) %>%
ungroup()
})
# Create Output Chart
output$Hist <- renderPlot({
selectedData() %>%
select(FctName, FctVal_S) %>%
ggplot(aes(x = FctVal_S, fill = FctName, color = FctName)) +
geom_histogram(bins = input$Bins, position = "identity", alpha = 0.4) +
labs(x = "Scaled Factor",
y = "Count",
title = "Histogram of Continuous Factor") +
theme_bw(base_size = 14)
})
# Create Report
output$Sumamry <- renderPrint({
selectedData() %>%
group_by(FctName) %>%
do(as_tibble(as.list(summary(c(.$FctVal_S)))))
})
}# Reference LIbraries
library(shiny)
library(magrittr)
library(tidyverse)
library(tidyquant)
library(highcharter)
library(scales)
# Clear Objects
rm(list = ls(all = TRUE))
# Set Directory
# ---
# Import Data
# ---
# Tidy Data
set.seed(100)
Period <- c(rep("2017-01-31", 1000),
rep("2017-02-28", 1000),
rep("2017-03-31", 1000)) %>% rep(2)
FctName <- c(rep("Quality", 3000), rep("Value", 3000))
FctVal <- c(runif(1000), runif(1000), runif(1000),
runif(1000), runif(1000), runif(1000))
X <- tibble(Period, FctName, FctVal)
# Create List Items
item_fct_name <- X %>% distinct(FctName) %>% as_vector() %>% unname()
item_date <- X %>% distinct(Period) %>% as_vector() %>% unname()# Set Title
ui_Title <-
h3(headerPanel("Scatter of Continuous Factor"))
# Set Sidebar
ui_Sidebar <-
sidebarPanel(
# Factor1
selectInput("Items1",
label = "Select First Factor (X-axis)",
choices = item_fct_name,
selected = item_fct_name[1],
multiple = TRUE,
selectize = FALSE),
# Another Factor
selectInput("Items2",
label = "Select Second Factor (Y-axis)",
choices = item_fct_name,
selected = item_fct_name[2],
multiple = TRUE,
selectize = FALSE),
# Period
selectInput("Period",
label = "Select Period (compatible Multiple Period)",
choices = item_date,
selected = tail(item_date, 1),
multiple = TRUE,
selectize = FALSE)
)
# Set Body
ui_Body <-
mainPanel(
plotOutput("Scatter", height = "700px")
#, verbatimTextOutput("Sumamry")
)
# Create UI
pageWithSidebar(ui_Title,
ui_Sidebar,
ui_Body)function(input, output, session) {
# Set Reactive
selectedData <- reactive({
X %>%
group_by(Period, FctName) %>%
mutate(FctVal = rescale(FctVal)) %>%
ungroup() %>%
select(Period, Symbol, FctName, FctVal) %>% {
X1 <- dplyr::filter(., Period == input$Period, FctName == input$Items1) %>%
set_colnames(c("Period", "Symbol", "FctName", "Factor1"))
X2 <- dplyr::filter(., Period == input$Period, FctName == input$Items2) %>%
set_colnames(c("Period", "Symbol", "FctName", "Factor2"))
inner_join(X1, X2, by = c("Period", "Symbol"))
}
})
# Create Output Chart
output$Scatter <- renderPlot({
selectedData() %>%
ggplot(aes(x = Factor1, y = Factor2, color = Period, fill = Period)) +
geom_point() +
geom_smooth(aes(color = Period, fill = Period), method = lm) +
geom_rug(aes(color = Period)) +
labs(x = "Factor1",
y = "Factor2",
title = "Scatter of Continuous Factor") +
theme_bw(base_size = 14)
})
# # Create Report
# output$Sumamry <- renderPrint({
# selectedData()
# })
#
}# Reference LIbraries
library(shiny)
library(magrittr)
library(tidyverse)
library(tidyquant)
library(highcharter)
library(scales)
# Clear Objects
rm(list = ls(all = TRUE))
# Set Directory
# ---
# Import Data
# ---
# Tidy Data
set.seed(100)
Period <- c(rep("2017-01-31", 1000),
rep("2017-02-28", 1000),
rep("2017-03-31", 1000)) %>% rep(2)
FctName <- c(rep("Quality", 3000), rep("Value", 3000))
Symbol <- c(paste0("S-", 1:1000),
paste0("S-", 1:1000),
paste0("S-", 1:1000)) %>% rep(2)
FctVal <- c(runif(1000), runif(1000), runif(1000),
runif(1000), runif(1000), runif(1000))
X <- tibble(Period, FctName, Symbol, FctVal)
# Create List Items
item_fct_name <- X %>% distinct(FctName) %>% as_vector() %>% unname()
item_date <- X %>% distinct(Period) %>% as_vector() %>% unname()# Set Title
ui_Title <-
h3(headerPanel("Interactive Scatter Matrix"))
# Set Sidebar
ui_Sidebar <-
sidebarPanel(
# Factor1
selectInput("Items1",
label = "Select Factor1",
choices = item_fct_name,
selected = item_fct_name[1],
multiple = TRUE,
selectize = FALSE),
# Factor2
selectInput("Items2",
label = "Select Factor2",
choices = item_fct_name,
selected = item_fct_name[2],
multiple = TRUE,
selectize = FALSE),
# Factor3
selectInput("Items3",
label = "Select Factor3",
choices = item_fct_name,
selected = item_fct_name[3],
multiple = TRUE,
selectize = FALSE),
# Period
selectInput("Period",
label = "Select Period (compatible Multiple Period)",
choices = item_date,
selected = tail(item_date, 1),
multiple = TRUE,
selectize = FALSE)
)
# Set Body
ui_Body <-
mainPanel(
pairsD3Output("Pairs", height = "700px")
)
# Create UI
# pageWithSidebar(ui_Title,
# ui_Sidebar,
# ui_Body)
navbarPage("PairsD3",
tabPanel("Plot",
sidebarLayout(ui_Sidebar,
ui_Body)
)
)function(input, output, session) {
# Set Reactive
selectedData <- reactive({
X %>%
group_by(Period, FctName) %>%
mutate(FctVal = rescale(FctVal)) %>%
ungroup() %>%
select(Period, Symbol, FctName, FctVal) %>% {
X1 <- dplyr::filter(., Period == input$Period, FctName == input$Items1) %>%
set_colnames(c("Period", "Symbol", "FctName", "Fct1"))
X2 <- dplyr::filter(., Period == input$Period, FctName == input$Items2) %>%
set_colnames(c("Period", "Symbol", "FctName", "Fct2"))
X3 <- dplyr::filter(., Period == input$Period, FctName == input$Items3) %>%
set_colnames(c("Period", "Symbol", "FctName", "Fct3"))
inner_join(X1, X2, by = c("Period", "Symbol")) %>%
inner_join(X3, by = c("Period", "Symbol")) %>%
select(Fct1, Fct2, Fct3) %>%
set_colnames(c(input$Items1, input$Items2, input$Items3))
}
})
# Create Output Chart
output$Pairs <- renderPairsD3({
selectedData() %>% pairsD3()
})
# Create Report
output$Sumamry <- renderPrint({
selectedData()
})
}# Reference LIbraries
library(shiny)
library(magrittr)
library(tidyverse)
library(tidyquant)
library(highcharter)
library(scales)
library(pairsD3)
# Clear Objects
rm(list = ls(all = TRUE))
# Set Directory
# ---
# Import Data
# ---
# Tidy Data
set.seed(100)
Period <- c(rep("2017-01-31", 1000),
rep("2017-02-28", 1000),
rep("2017-03-31", 1000)) %>% rep(3)
FctName <- c(rep("Quality", 3000), rep("Value", 3000), rep("Return", 3000))
Symbol <- c(paste0("S-", 1:1000),
paste0("S-", 1:1000),
paste0("S-", 1:1000)) %>% rep(3)
FctGrp <- c(sample(c("G1", "G2", "G3"), 1000, replace=TRUE),
sample(c("G1", "G2", "G3"), 1000, replace=TRUE),
sample(c("G1", "G2", "G3"), 1000, replace=TRUE)) %>% rep(3)
FctVal <- c(runif(1000), runif(1000), runif(1000),
runif(1000), runif(1000), runif(1000),
runif(1000), runif(1000), runif(1000))
X <- tibble(Period, FctName, FctGrp, Symbol, FctVal)
# Create List Items
item_fct_name <- X %>% distinct(FctName) %>% as_vector() %>% unname()
item_date <- X %>% distinct(Period) %>% as_vector() %>% unname()
item_grp <- X %>% distinct(FctGrp) %>% as_vector() %>% unname()# Set Title
ui_Title <-
h3(headerPanel("Factor Validity Analysis"))
# Set Sidebar
ui_Sidebar <-
sidebarPanel(
# Universe
selectInput("tgtUniv",
label = "Target Universe",
choices = item_univ,
selected = item_univ[1]),
# Target Factor
selectInput("tgtFactor",
label = "Target Factor",
choices = item_fct,
selected = item_fct[1],
multiple = TRUE,
selectize = FALSE),
# Target Factor Tiles
numericInput("tgtTiles",
label = "Tiles of Target Factor",
value = 5,
min = 2,
max = 10),
# Period
dateRangeInput("rngPeriod",
label = "Backtest Period",
start = head(item_date, 1),
end = tail(item_date, 1),
format = "yyyy-mm"
),
# Choose Neutral Type
radioButtons("Type",
label = "Choose Neutral Type",
choices = list("Not Apply" = 0,
"Group Factor" = 1,
"Tiled Factor" = 2),
selected = 0),
# Neutral Group
selectInput("ntlGroup",
label = "Group Factor",
choices = item_grp,
selected = item_grp[1],
multiple = TRUE,
selectize = FALSE),
# Neutral Factor
selectInput("ntlFactor",
label = "Tiled Factor",
choices = item_fct,
selected = item_fct[1],
multiple = TRUE,
selectize = FALSE),
# Neutral Factor Tiles
numericInput("ntlTiles",
label = "Tiles of Neutral Factor",
value = 5,
min = 2,
max = 10),
# Return Type
checkboxInput("Rtn",
label = "Apply Median Return",
value = FALSE)
)
# Set Body
ui_Body <-
mainPanel(
verbatimTextOutput("Summary")
)
# Create UI
pageWithSidebar(ui_Title,
ui_Sidebar,
ui_Body)function(input, output, session) {
selectedData <- reactive({
# Neutral Factor Datasets
XXXF <-
XXX %>%
dplyr::filter(FctName == input$ntlFactor) %>%
select(Univ, Period, Symbol, NtlName = FctName, NtlVal = FctVal)
# Input Data
tgtTiles <- input$tgtTiles
ntlTiles <- ifelse(input$tgtFactor == input$ntlFactor,
input$tgtTiles, input$ntlTiles)
# Data Manipulation
XXX %>%
dplyr::filter(Univ == input$tgtUniv) %>%
dplyr::filter(Period >= input$rngPeriod[1],
Period <= input$rngPeriod[2]) %>%
dplyr::filter(FctName == input$tgtFactor) %>%
left_join(XXXF, by = c("Univ" = "Univ", "Period" = "Period", "Symbol" = "Symbol")) %>%
group_by(Period) %>%
mutate(IC_All = cor(FctVal, return, use = "complete.obs", method = "spearman"),
Rtn_Avg_All = mean(return, na.rm = TRUE),
Rtn_Med_All = median(return, na.rm = TRUE),
IC_All_Cum = cumsum(IC_All)) %>%
mutate(tgtTile = ntile(FctVal, tgtTiles),
ntlTile = ntile(NtlVal, ntlTiles)) %>%
mutate_(ntlGroup = input$ntlGroup) %>% {
switch(input$Type,
"0" = group_by(., Period, tgtTile),
"1" = group_by(., Period, ntlGroup, tgtTile),
"2" = group_by(., Period, ntlTile, tgtTile)
)
} %>%
mutate(IC_Tile = cor(FctVal, return, method = "spearman"),
Rtn_Avg_Tile = mean(return, na.rm = TRUE),
Rtn_Med_Tile = median(return, na.rm = TRUE),
Rtn_Avg_Diff = Rtn_Avg_Tile - Rtn_Avg_All,
Rtn_Med_Diff = Rtn_Med_Tile - Rtn_Med_All,
IC_Tile_Cum = cumsum(IC_Tile),
Rtn_Avg_Cum = cumsum(Rtn_Avg_Diff),
Rtn_Med_Cum = cumsum(Rtn_Med_Diff))
})
# Create Output Chart
# output$Pairs <- renderPairsD3({
# selectedData() %>% pairsD3()
# })
# Create Report
output$Summary <- renderPrint({
selectedData() %>%
#group_by(Univ, Period, ntlGroup, NtlName, ntlTile, FctName, tgtTile) %>%
tally() %T>% clipr::write_clip()
})
}# Reference LIbraries
library(shiny)
library(magrittr)
library(tidyverse)
library(scales)
library(stringr)
library(lubridate)
# Clear Objects
rm(list = ls(all = TRUE))
# Set Directory
# ---
# Import Data
# ---
set.seed(100)
Period <- c(rep("2017-01-31", 1000),
rep("2017-02-28", 1000),
rep("2017-03-31", 1000)) %>% ymd()
Symbol <- c(paste0("S-", 1001:2000),
paste0("S-", 1001:2000),
paste0("S-", 1001:2000))
return <- c(rnorm(1000),
rnorm(1000),
rnorm(1000))
Value <- c(rnorm(1000),
rnorm(1000),
rnorm(1000))
Quality <- c(rnorm(1000),
rnorm(1000),
rnorm(1000))
FctGrp1 <- c(sample(c("G1", "G2", "G3"), 1000, replace=TRUE),
sample(c("G1", "G2", "G3"), 1000, replace=TRUE),
sample(c("G1", "G2", "G3"), 1000, replace=TRUE))
FctGrp2 <- c(sample(c("G11", "G12", "G13"), 1000, replace=TRUE),
sample(c("G11", "G12", "G13"), 1000, replace=TRUE),
sample(c("G11", "G12", "G13"), 1000, replace=TRUE))
XX <- tibble(Univ = "All", Period, Symbol, return, FctGrp1, FctGrp2, Value, Quality)
XY <- tibble(Univ = "MSCI Kokusai", Period, Symbol, return, FctGrp1, FctGrp2, Value, Quality)
XZ <- bind_rows(XX, XY)
XXX <-
XZ %>%
gather(FctName, FctVal, -(Univ:FctGrp2))
# mutate(NtlName = FctName, NtlVal = FctVal)
item_univ <- XXX %>% distinct(Univ) %>% as_vector() %>% unname()
item_fct <- XXX %>% distinct(FctName) %>% as_vector() %>% unname()
item_date <- XXX %>% distinct(Period) %>% as_vector() %>% unname() %>% as_date()
item_grp <- XXX %>% select(FctGrp1, FctGrp2) %>% names()