.Rhistory

distribution.model="sstd",
fixed.pars = list(mu=0)
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
show(fit)
spec = ugarchspec(
mean.model=list(armaOrder=c(1,1),
archm=TRUE,
external.regressors=as.matrix(cbind(lundi,janvier))),
distribution.model="sstd"
) # mxreg2 pas significatif (effet janvier)
spec = ugarchspec(
mean.model=list(armaOrder=c(1,1),
archm=TRUE,
external.regressors=as.matrix(cbind(lundi))),
distribution.model="sstd"
) # ar1 pas significatif
spec = ugarchspec(
mean.model=list(armaOrder=c(0,1),
archm=TRUE,
external.regressors=as.matrix(cbind(lundi))),
distribution.model="sstd"
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
show(fit)
spec = ugarchspec(
mean.model=list(armaOrder=c(1,1), external.regressors=as.matrix(cbind(lundi,janvier)))
) # ar1 pas significatif
spec = ugarchspec(
mean.model=list(armaOrder=c(0,1), external.regressors=as.matrix(cbind(lundi,janvier)))
) # mxreg2 (janvier) pas significatif
spec = ugarchspec(
mean.model=list(armaOrder=c(0,1), external.regressors=as.matrix(cbind(lundi)))
)
fit = ugarchfit(
spec,
data = rte
)
show(fit)
lundi=as.integer(jour=="Monday")
spec = ugarchspec(
variance.model=list(model="apARCH", garchOrder=c(1,1)),
mean.model=list(armaOrder=c(0,1), external.regressors=as.matrix(cbind(lundi))),
distribution.model="sstd",
fixed.pars = list(delta=1)
)
no_cores = detectCores() - 1
cl = makeCluster(no_cores)
roll = ugarchroll(
spec,
rt,
n.ahead=1,
forecast.length=length(rtt),
refit.every=40,
refit.window="moving",
solver = "hybrid",
cluster=cl,
VaR.alpha=0.05
)
stopCluster(cl)
valueatrisk = zoo(roll@forecast$VaR[,1])
reelles = zoo(roll@forecast$VaR[,2])
index = rownames(roll@forecast$VaR)
# plot
plot(dates[1762:N],reelles,type='b',xlab="Dates",ylab="Rendements et VaR")
lines(dates[1762:N],valueatrisk,type='l',col="red")
legend("topright",inset=.05,c("rt","VaR"),col=1:2,lty=c(1,1))
report(roll, type="VaR", VaR.alpha=0.05, conf.level=0.95)
VaR(rte, p=.95, method="historical")
alpha=0.95
backTestVaR = function(x, p = alpha) {
normal.VaR = as.numeric(VaR(x, p=p, method="gaussian"))
historical.VaR = as.numeric(VaR(x, p=p, method="historical"))
modified.VaR = as.numeric(VaR(x, p=p, method="modified"))
ans = c(normal.VaR, historical.VaR, modified.VaR)
names(ans) = c("Normal", "HS", "Modified")
return(ans)
}
# rolling 1-step ahead estimates of VaR
VaR.results = rollapply(
as.zoo(rt),
width=Ne,
FUN = backTestVaR,
p=alpha,
by.column = FALSE,
align = "right"
)
violations.mat = matrix(0, 3, 5)
rownames(violations.mat) = c("Normal", "HS", "Modified")
colnames(violations.mat) = c("En1", "n1", "1-alpha", "Percent", "VR")
violations.mat[, "En1"] = (1-alpha)*Nt
violations.mat[, "1-alpha"] = 1 - alpha
normalVaR.violations = as.numeric(as.zoo(rt[index(VaR.results)])) < VaR.results[, "Normal"]
violation.dates = index(normalVaR.violations[which(normalVaR.violations)])
for(i in colnames(VaR.results)) {
VaR.violations = as.numeric(as.zoo(rt[index(VaR.results)])) < VaR.results[, i]
violations.mat[i, "n1"] = sum(VaR.violations)
violations.mat[i, "Percent"] = sum(VaR.violations)/Nt
violations.mat[i, "VR"] = violations.mat[i, "n1"]/violations.mat[i, "En1"]
}
resultats<-data.frame(matrix(NA,ncol=4,nrow=3))
colnames(resultats)<-c("expected.exceed","actual.exceed","Kupiecpv","Christoffersenpv")
rownames(resultats)<-c("Normale","HS","CF")
# normale
VaR.test1 = VaRTest(1-alpha,actual=coredata(rt[index(VaR.results)]), VaR=coredata(VaR.results[,"Normal"]))
resultats[1,1]=VaR.test1$expected.exceed
resultats[1,2]=VaR.test1$actual.exceed
resultats[1,3]=VaR.test1$uc.LRp
resultats[1,4]=VaR.test1$cc.LRp
# historique
VaR.test2 = VaRTest(1-alpha,actual=coredata(rt[index(VaR.results)]), VaR=coredata(VaR.results[,"HS"]))
resultats[2,1]=VaR.test2$expected.exceed
resultats[2,2]=VaR.test2$actual.exceed
resultats[2,3]=VaR.test2$uc.LRp
resultats[2,4]=VaR.test2$cc.LRp
# modifie
VaR.test3 = VaRTest(1-alpha, actual=coredata(rt[index(VaR.results)]), VaR=coredata(VaR.results[,"Modified"]))
resultats[3,1]=VaR.test3$expected.exceed
resultats[3,2]=VaR.test3$actual.exceed
resultats[3,3]=VaR.test3$uc.LRp
resultats[3,4]=VaR.test3$cc.LRp
resultats
spec = ugarchspec(
variance.model=list(model="gjrGARCH", garchOrder=c(1,1)),
mean.model=list(armaOrder=c(0,1)),
distribution.model="sstd",
fixed.pars = list(alpha1=0, mu=0)
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
show(fit)
spec = ugarchspec(
variance.model=list(model="eGARCH", garchOrder=c(1,1)),
mean.model=list(armaOrder=c(1,1), external.regressors=as.matrix(cbind(lundi))),
distribution.model="sstd"
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
show(fit)
spec = ugarchspec(
variance.model=list(model="iGARCH", garchOrder=c(1,1)),
mean.model=list(armaOrder=c(0,1)),
distribution.model="sstd",
fixed.pars = list(mu=0)
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
show(fit)
spec = ugarchspec(
mean.model=list(armaOrder=c(0,1),
archm=TRUE,
external.regressors=as.matrix(cbind(lundi))),
distribution.model="sstd"
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
fit = ugarchfit(
spec = spec,
data = rte,
solver = 'hybrid'
)
show(fit)
spec = ugarchspec(
mean.model=list(armaOrder=c(0,1), external.regressors=as.matrix(cbind(lundi)))
)
fit = ugarchfit(
spec,
data = rte
)
show(fit)
rm(list=ls())
library(tidyverse)
library(rvest)
library(reactablefmtr)
install.packages("reactablefmtr")
library(reactablefmtr)
library(reactable)
library(htmltools)
library(htmlwidgets)
library(sysfonts)
library(showtext)
library(webshot2)
install.packages('webshot2')
library(webshot2)
#wikipedia data
url_women<-'https://en.wikipedia.org/wiki/List_of_Grand_Slam_women%27s_singles_champions'
#scrape data with rvest
raw<-url_women%>%
rvest::read_html()%>%
rvest::html_elements(".wikitable")%>%
.[3]%>%
html_table()%>%
.[[1]]%>%
rename(titles=1, player=2, ae=3, oe=4, australian_open = 5, french_open = 6, wimbledon=7,
us_open=8, years=9)
#clean-up and reshape data with dplyr
df<-raw%>%
mutate(player = trimws(str_replace_all(player,"\\/","")),
ae = as.integer(str_replace(ae, "N/A",NA_character_)),
oe = as.integer(str_replace(oe, "N/A",NA_character_)),
rank = dense_rank(desc(titles)),
)%>%
select(rank, player, years, australian_open, french_open, us_open, wimbledon, titles)
#get first 11 records
df<-df%>%head(11)
#add in region manually
df$region<-c("AU","US","DE",rep("US",6),"FR","US")
df$region<-paste0("https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/",df$region,".svg")
View(df)
getwd()
setwd("/Users/josephbarbier/Desktop/R-graph-gallery/DATA")
/Users/josephbarbier/Desktop/R-graph-gallery/DATA
getwd()
rm(list=ls())
library(tidyverse)
library(rvest)
library(reactablefmtr)
library(reactable)
library(htmltools)
library(htmlwidgets)
library(sysfonts)
library(showtext)
library(webshot2)
#wikipedia data
url_women<-'https://en.wikipedia.org/wiki/List_of_Grand_Slam_women%27s_singles_champions'
#scrape data with rvest
raw<-url_women%>%
rvest::read_html()%>%
rvest::html_elements(".wikitable")%>%
.[3]%>%
html_table()%>%
.[[1]]%>%
rename(titles=1, player=2, ae=3, oe=4, australian_open = 5, french_open = 6, wimbledon=7,
us_open=8, years=9)
#clean-up and reshape data with dplyr
df<-raw%>%
mutate(player = trimws(str_replace_all(player,"\\/","")),
ae = as.integer(str_replace(ae, "N/A",NA_character_)),
oe = as.integer(str_replace(oe, "N/A",NA_character_)),
rank = dense_rank(desc(titles)),
)%>%
select(rank, player, years, australian_open, french_open, us_open, wimbledon, titles)
#get first 11 records
df<-df%>%head(11)
#add in region manually
df$region<-c("AU","US","DE",rep("US",6),"FR","US")
df$region<-paste0("https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/",df$region,".svg")
write.csv(df, "/Users/josephbarbier/Desktop/R-graph-gallery/DATA/tennis-best-players.csv", row.names=FALSE)
# REMOVE WHEN MERGING
# url = 'https://raw.githubusercontent.com/holtzy/R-graph-gallery/master/DATA/tennis-best-players.csv'
# data_table <- readRDS(url)
data_table = read.csv2("DATA/tennis-best-players.csv")
getwd()
# REMOVE WHEN MERGING
# url = 'https://raw.githubusercontent.com/holtzy/R-graph-gallery/master/DATA/tennis-best-players.csv'
# data_table <- readRDS(url)
data_table = read.csv2("../DATA/tennis-best-players.csv")
View(data_table)
# REMOVE WHEN MERGING
# url = 'https://raw.githubusercontent.com/holtzy/R-graph-gallery/master/DATA/tennis-best-players.csv'
# data_table <- readRDS(url)
data_table = read.csv2("../DATA/tennis-best-players.csv", sep=',')
View(data_table)
# REMOVE WHEN MERGING
# url = 'https://raw.githubusercontent.com/holtzy/R-graph-gallery/master/DATA/tennis-best-players.csv'
# data_table <- readRDS(url)
df = read.csv2("../DATA/tennis-best-players.csv", sep=',')
#create custom color palette for scale fill
pal_scale<-c("#F4FFFD","#E9DAEC","#A270E5","#43009A")
#main body of reactable - note, I downloaded the Chivo font locally from Google Fonts first!
table<-reactable(df%>%select(rank, player, region, australian_open, french_open, us_open, wimbledon, titles),
theme = reactableTheme(
style=list(fontFamily="Chivo"),
borderColor="#DADADA"
),
defaultPageSize = 11,
defaultColDef = colDef(vAlign="center",
align="center",
headerVAlign="center",
style = color_scales(df, span = 4:7, colors=pal_scale),
headerStyle = list(fontFamily="Chivo"),
width=90
),
columnGroups = list(
colGroup(name="", columns=c("player","region","titles"), headerStyle = list(fontFamily="Chivo"), align="left"),
colGroup(name="Event", columns=c("australian_open","us_open","french_open","wimbledon"), headerStyle = list(fontFamily="Roboto"))
),
columns = list(
rank = colDef(show=FALSE),
player = colDef(name= "Player (First Title - Last Title)",
align="left", width=250,
cell=function(value){
image <- img(src = paste0("https://raw.githubusercontent.com/tashapiro/tanya-data-viz/main/tennis/images/",str_replace_all(tolower(value)," ","_"),".png"), style = "height: 33px;", alt = value)
tagList(
div(style = "display: inline-block;vertical-align:middle;width:50px", image),
div(style="display: inline-block;vertical-align:middle;",
div(style = "vertical-align:middle;", value),
div(style = "vertical-align:middle;font-size:8pt;color:#8C8C8C;", paste0("(",df[df$player==value,]$years),")"))
)}
),
region = colDef(name="Region",
align="left",
cell=function(value, index){
image <- img(src = value, style = "width:60px;height:20px;", alt = value)
player <- df$player[index]
if(player %in% c("Monica Seles","Molla Bjurstedt Mallory")){
tagList(div(style = "display:inline-block;vertical-align:middle;width:80px", image,"*")
# div(style = "display:inline-block;", "*")
)
}
else{
tagList(div(style = "display:inline-block;vertical-align:middle;width:50px", image))
}
},
width=120),
australian_open = colDef(name="AU Open"),
french_open = colDef(name="FR Open"),
us_open = colDef(name="US Open"),
wimbledon = colDef(name="Wmbl"),
titles = colDef(name="Total Titles",
width=180,
class = "border-left",
align="left",
cell = data_bars(df,
fill_color="#7814ff",
text_position = "outside-end",
bar_height = 10,
text_size = 12,
min_value=5,
max_value =32,
background = "transparent"))
)
)
#add title, subtitle, footnote and source
#note, I downloaded fonts locally - Chivo & Font Awesome Branded Icons
table_final<-table%>%
#title & subtitle
htmlwidgets::prependContent(
tagList(
tags$img(src = "https://pngimg.com/uploads/tennis/tennis_PNG10416.png", style = "width:50px;height:34px;display:inline-block;vertical-align:middle;"),
#tags$h1("trophy  ",style="font-family:'Font Awesome 6 Free';margin-bottom:0;display:inline-block;vertical-align:middle;padding-right:10px;"),
tags$div("Grand Slam Legends", style="font-size:32px;font-weight:bold;font-family:Chivo;margin-bottom:0;display:inline-block;vertical-align:middle;"),
tags$h3("Top Women's Tennis Players by Singles Championship Titles", style="font-family:Chivo;margin-bottom:0;margin-top:0;font-weight:400;color:#8C8C8C;padding-left:10px;")
)
)%>%
#footnote and source
htmlwidgets::appendContent(
tags$div("* Player represented more than one country during career. Most recent country shown.", style="font-family:Roboto;color:black;font-size:9pt;border-bottom-style:solid;border-top-style:solid;width:910px;padding-bottom:8px;padding-top:8px;border-color:#DADADA;"),
tags$div(
tags$div("Data: Wikipedia as of November 2022 | Graphic: ", style="display:inline-block;vertical-align:middle;"),
tags$div("twitter", style="font-family:'Font Awesome 6 Brands';display:inline-block;vertical-align:middle;"),
tags$div("tanya_shapiro", style="display:inline-block;vertical-align:middle;"),
tags$div("github", style="font-family:'Font Awesome 6 Brands';display:inline-block;vertical-align:middle;"),
tags$div("tashapiro", style="display:inline-block;vertical-align:middle;"),
style="font-family:Chivo;color:#8C8C8C;font-size:10pt;width:910px;padding-top:8px;display:inline-block;vertical-align:middle;")
)
#preview table
table_final
html = "HtmlWidget/web-interactive-table-with-images-and-charts.html"
saveWidget(table_final, html)
setwd("/Users/josephbarbier/Desktop/R-graph-gallery")
# Chunk 1: global options
knitr::opts_chunk$set(
warning=FALSE,
message=FALSE
)
# Chunk 2
library(tidyverse)
library(rvest)
library(reactablefmtr)
library(reactable)
library(htmltools)
library(htmlwidgets)
library(sysfonts)
library(showtext)
library(webshot2)
# Chunk 3: data
# REMOVE WHEN MERGING
# url = 'https://raw.githubusercontent.com/holtzy/R-graph-gallery/master/DATA/tennis-best-players.csv'
# data_table <- readRDS(url)
df = read.csv2("DATA/tennis-best-players.csv", sep=',')
# Chunk 4
#create custom color palette for scale fill
pal_scale<-c("#F4FFFD","#E9DAEC","#A270E5","#43009A")
#main body of reactable - note, I downloaded the Chivo font locally from Google Fonts first!
table<-reactable(df%>%select(rank, player, region, australian_open, french_open, us_open, wimbledon, titles),
theme = reactableTheme(
style=list(fontFamily="Chivo"),
borderColor="#DADADA"
),
defaultPageSize = 11,
defaultColDef = colDef(vAlign="center",
align="center",
headerVAlign="center",
style = color_scales(df, span = 4:7, colors=pal_scale),
headerStyle = list(fontFamily="Chivo"),
width=90
),
columnGroups = list(
colGroup(name="", columns=c("player","region","titles"), headerStyle = list(fontFamily="Chivo"), align="left"),
colGroup(name="Event", columns=c("australian_open","us_open","french_open","wimbledon"), headerStyle = list(fontFamily="Roboto"))
),
columns = list(
rank = colDef(show=FALSE),
player = colDef(name= "Player (First Title - Last Title)",
align="left", width=250,
cell=function(value){
image <- img(src = paste0("https://raw.githubusercontent.com/tashapiro/tanya-data-viz/main/tennis/images/",str_replace_all(tolower(value)," ","_"),".png"), style = "height: 33px;", alt = value)
tagList(
div(style = "display: inline-block;vertical-align:middle;width:50px", image),
div(style="display: inline-block;vertical-align:middle;",
div(style = "vertical-align:middle;", value),
div(style = "vertical-align:middle;font-size:8pt;color:#8C8C8C;", paste0("(",df[df$player==value,]$years),")"))
)}
),
region = colDef(name="Region",
align="left",
cell=function(value, index){
image <- img(src = value, style = "width:60px;height:20px;", alt = value)
player <- df$player[index]
if(player %in% c("Monica Seles","Molla Bjurstedt Mallory")){
tagList(div(style = "display:inline-block;vertical-align:middle;width:80px", image,"*")
# div(style = "display:inline-block;", "*")
)
}
else{
tagList(div(style = "display:inline-block;vertical-align:middle;width:50px", image))
}
},
width=120),
australian_open = colDef(name="AU Open"),
french_open = colDef(name="FR Open"),
us_open = colDef(name="US Open"),
wimbledon = colDef(name="Wmbl"),
titles = colDef(name="Total Titles",
width=180,
class = "border-left",
align="left",
cell = data_bars(df,
fill_color="#7814ff",
text_position = "outside-end",
bar_height = 10,
text_size = 12,
min_value=5,
max_value =32,
background = "transparent"))
)
)
#add title, subtitle, footnote and source
#note, I downloaded fonts locally - Chivo & Font Awesome Branded Icons
table_final<-table%>%
#title & subtitle
htmlwidgets::prependContent(
tagList(
tags$img(src = "https://pngimg.com/uploads/tennis/tennis_PNG10416.png", style = "width:50px;height:34px;display:inline-block;vertical-align:middle;"),
#tags$h1("trophy  ",style="font-family:'Font Awesome 6 Free';margin-bottom:0;display:inline-block;vertical-align:middle;padding-right:10px;"),
tags$div("Grand Slam Legends", style="font-size:32px;font-weight:bold;font-family:Chivo;margin-bottom:0;display:inline-block;vertical-align:middle;"),
tags$h3("Top Women's Tennis Players by Singles Championship Titles", style="font-family:Chivo;margin-bottom:0;margin-top:0;font-weight:400;color:#8C8C8C;padding-left:10px;")
)
)%>%
#footnote and source
htmlwidgets::appendContent(
tags$div("* Player represented more than one country during career. Most recent country shown.", style="font-family:Roboto;color:black;font-size:9pt;border-bottom-style:solid;border-top-style:solid;width:910px;padding-bottom:8px;padding-top:8px;border-color:#DADADA;"),
tags$div(
tags$div("Data: Wikipedia as of November 2022 | Graphic: ", style="display:inline-block;vertical-align:middle;"),
tags$div("twitter", style="font-family:'Font Awesome 6 Brands';display:inline-block;vertical-align:middle;"),
tags$div("tanya_shapiro", style="display:inline-block;vertical-align:middle;"),
tags$div("github", style="font-family:'Font Awesome 6 Brands';display:inline-block;vertical-align:middle;"),
tags$div("tashapiro", style="display:inline-block;vertical-align:middle;"),
style="font-family:Chivo;color:#8C8C8C;font-size:10pt;width:910px;padding-top:8px;display:inline-block;vertical-align:middle;")
)
#preview table
table_final
html = "HtmlWidget/web-interactive-table-with-images-and-charts.html"
saveWidget(table_final, html)
styler:::style_selection()
styler:::style_selection()