f <- forecast(model, h = 1, level = mylevels)
c <- mylevels/2
alpha <- 50 + c(rev(-c), c)
quantile_forecasts <- c(rev(f$lower), f$upper)
quantile_forecasts
traceback()
param_forecast
qlow <- res$lower[, seq(ncol(res$lower), 1)]
qup <- res$upper[, -1]
t(cbind(qlow, qup))
param_forecast
#mylevels <- seq(0, 98, 2)
#f <- forecast(model, h = 1, level = mylevels)
c <- param_forecast$level/2
alpha <- 50 + c(rev(-c), c)
alpha
quantile_forecasts <- c(rev(f$lower), f$upper)
res <- do.call(forecast, c(list(object = model, h = H), param_forecast))
mf[i, ] <- res$mean
future[i, ] <- series[ts_split[2] + seq(1, H)]
#mylevels <- seq(0, 98, 2)
#f <- forecast(model, h = 1, level = mylevels)
c <- param_forecast$level/2
alpha <- 50 + c(rev(-c), c)
#mylevels <- seq(0, 98, 2)
#f <- forecast(model, h = 1, level = mylevels)
gamma <- param_forecast$level/2
alpha <- 50 + c(rev(-gamma), gamma)
f <- do.call(forecast, c(list(object = model, h = H), param_forecast))
mf[i, ] <- res$mean
future[i, ] <- series[ts_split[2] + seq(1, H)]
#mylevels <- seq(0, 98, 2)
#f <- forecast(model, h = 1, level = mylevels)
gamma <- param_forecast$level/2
alpha <- 50 + c(rev(-gamma), gamma)
quantile_forecasts <- c(rev(f$lower), f$upper)
quantile_forecasts
dim(f$lower)
cbind(apply(f$lower, 1, rev), f$upper)
dim(f$upper)
dim(apply(f$lower, 1, rev))
x <- cbind(t(apply(f$lower, 1, rev)), f$upper)
dim(x)
x[1, ]
dim(f$lower)
qf <- sapply(seq(H), function(h){
c(rev(f$lower[h, ]), f$upper[h, ])
})
dim(qf)
qf[, 1]
plot(qf[, 1])
plot(qf[, 1], alpha)
alpha
alpha/100
alpha <- (50 + c(rev(-gamma), gamma))/100
alpha
res <- do.call(forecast, c(list(object = model, h = H), param_forecast))
qlow <- res$lower[, seq(ncol(res$lower), 1)]
qup <- res$upper[, -1]
qf[, , i] <- t(cbind(qlow, qup))
dim(t(cbind(qlow, qup)))
source("newmain.R")
source("newmain.R")
source("newmain.R")
dim(quantf)
dim(qf[, , i] )
f$upper[h, ]
f$upper
h
h <- 1
f$upper
f$upper[h, ]
source("newmain.R")
dim(quantf)
quantf
dim(quantf)
dim(qf[, , i] )
source("newmain.R")
source("newmain.R")
source("newmain.R")
dim(test_results[[1]]$mintdiagonal)
if(task == "scoring"){
err_test <- lapply(seq(H), function(h){
lapply(seq(n_test), function(itest){ # itest
lapply(test_results[[itest]], function(mat_method){ # imethod
obs <- results$allfuture[, itest, h]
X <- mat_method[, , h]
crps <- compute_crps(X, obs)
squared_erors <- (apply(X, 2, mean) - obs)^2
qs <- compute_qscores(X, obs)
qs_tails <- apply(qs, 2, function(x){ mean(x * weights_tails) })
qs_uniform <- apply(qs, 2, function(x){ mean(x * weights_uniform) })
qs_rtail <- apply(qs, 2, function(x){ mean(x * weights_rtail) })
qs_ltail <- apply(qs, 2, function(x){ mean(x * weights_ltail) })
# DO NOT SAVE qs (too big)
list(crps = crps, squared_erors = squared_erors, qs_tails = qs_tails, qs_rtail = qs_rtail, qs_ltail = qs_ltail, qs_uniform = qs_uniform)
})
})
})
list_simulations[[i]] <- err_test
}else if(task == "recovery"){}
fpkg_levels
do.recovery <- TRUE
obj.path <- ifelse(do.recovery, list(npaths = 500), NULL)
obj.path
source("newmain.R")
T_test
traceback()
source("newmain.R")
H
source("newmain.R")
load(filetosave)
for(i in seq(nb_simulations)){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
stop("done")
}
dim(samples_pred)
samples_pred
length(samples_pred)
dim(samples_pred$mintdiagonal)
dim(samples_true)
samples_true <- aperm(samples_true, c(2, 1, 3))
dim(samples_true)
res <- sapply(samples_pred, function(mat){
mat[, j, h]
})
j <- 1
samples_pred
res <- sapply(samples_pred, function(mat){
mat[, j, h]
})
dim(res)
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
dim(samples_method)
dim(samples_method)
ks.test()
lapply(seq_along(ncol(samples_method)), function(jcol){
ks.test(samples_method[, jcol], samples_true[, j, h])
browser()
})
ks.test(samples_method[, jcol], samples_true[, j, h])
lapply(seq_along(ncol(samples_method)), function(jcol){
res_test <- ks.test(samples_method[, jcol], samples_true[, j, h])
browser()
})
res_test
str(res_test)
sapply(seq_along(ncol(samples_method)), function(jcol){
res_test <- ks.test(samples_method[, jcol], samples_true[, j, h])
res_test$statisic
})
jcol <- 1
res_test <- ks.test(samples_method[, jcol], samples_true[, j, h])
res_Test
res_test$statistic
sapply(seq_along(ncol(samples_method)), function(jcol){
res_test <- ks.test(samples_method[, jcol], samples_true[, j, h])
res_test$statistic
})
ncol(samples_method)
sapply(seq(ncol(samples_method)), function(jcol){
res_test <- ks.test(samples_method[, jcol], samples_true[, j, h])
res_test$statistic
})
load(filetosave)
h <- 1
mat_test <- matrix(NA, nrow = nb_simulations, ncol = 6)
for(i in seq(nb_simulations)){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
mat_test[i, ] <- sapply(seq(ncol(samples_method)), function(jcol){
res_test <- ks.test(samples_method[, jcol], samples_true[, j, h])
res_test$statistic
})
}
warnings()
mat_test
boxplot(mat_test)
head(samples_method)
samples_method[, "base"]
load(filetosave)
h <- 1
mat_test <- matrix(NA, nrow = nb_simulations, ncol = 6)
for(i in seq(nb_simulations)){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
mat_test[i, ] <- sapply(seq_along(colnames(samples_method)), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
res_test$statistic
})
}
mat_test
? sapply
colnames(samples_method)
load(filetosave)
h <- 1
mat_test <- matrix(NA, nrow = nb_simulations, ncol = 6)
for(i in seq(nb_simulations)){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
mat_test[i, ] <- sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
res_test$statistic
})
}
mat_test
colnames(samples_method)
lapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
res_test$statistic
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
res_test$statistic
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
load(filetosave)
h <- 1
mat_test <- sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
})
mat_test
mat_test <- t(mat_test)
mat_test
boxplot(mat_test)
j
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
})
})
dim(mat_test)
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
})
}, simplify = "array")
dim(mat_test)
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
t(sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
}))
})
}, simplify = "array")
dim(mat_test)
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
})
}, simplify = "array")
dim(mat_test)
mat_test <- aperm(mat_test, c(2, 1, 3))
dim(mat_test)
par(mfrow  = c(2, 4))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
par(mfrow  = c(2, 4))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
names(test_results[[itest]])
source("newmain.R")
load(filetosave)
h <- 1
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
})
}, simplify = "array")
mat_test <- aperm(mat_test, c(2, 1, 3))
#par(mfrow  = c(2, 4))
par(mfrow  = c(4, 2))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
load(filetosave)
h <- 1
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
as.numeric(res_test$statistic)
})
})
}, simplify = "array")
mat_test <- aperm(mat_test, c(2, 1, 3))
#par(mfrow  = c(2, 4))
par(mfrow  = c(4, 2))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
par(mfrow  = c(3, 2))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
par(mfrow  = c(2, 3))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
#as.numeric(res_test$statistic)
as.numeric(res_test$pvalue)
})
})
}, simplify = "array")
warnings()
mat_test <- aperm(mat_test, c(2, 1, 3))
par(mfrow  = c(2, 3))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
#as.numeric(res_test$statistic)
browser()
as.numeric(res_test$pvalue)
})
})
}, simplify = "array")
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
#as.numeric(res_test$statistic)
browser()
as.numeric(res_test$p.value)
})
})
}, simplify = "array")
mat_test <- aperm(mat_test, c(2, 1, 3))
#par(mfrow  = c(2, 4))
par(mfrow  = c(2, 3))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
mat_test <- sapply(seq(7), function(j){
sapply(seq(nb_simulations), function(i){
samples_pred <- list_simulations[[i]]$samples_pred
samples_true <- list_simulations[[i]]$samples_true
samples_true <- aperm(samples_true, c(2, 1, 3))
samples_method <- sapply(samples_pred, function(mat){
mat[, j, h]
})
sapply(colnames(samples_method), function(mycol){
res_test <- ks.test(samples_method[, mycol], samples_true[, j, h])
#as.numeric(res_test$statistic)
#browser()
as.numeric(res_test$p.value)
})
})
}, simplify = "array")
mat_test <- aperm(mat_test, c(2, 1, 3))
#par(mfrow  = c(2, 4))
par(mfrow  = c(2, 3))
for(j in seq(7)){
boxplot(mat_test[, , j])
}
simulate_small_hts
source("config_paths.R")
source("packages.R")
source("bights.R")
source("simulate.R")
source("utils.R")
source("mint.R")
source("code.R")
source("permutations.R")
source("aggregation.R")
source("nicefigs.R")
source("config_paths.R")
source("packages.R")
source("bights.R")
source("simulate.R")
source("utils.R")
simulate_small_hts
n_simul = 500
marg <- "norm"
obj.path <- NULL 
 obj_simul <- simulate_small_hts(n_simul, marg, obj.path)
fixed.dgp <- FALSE
obj_simul <- simulate_small_hts(n_simul, marg, obj.path)
source("code.R")
source("permutations.R")
source("aggregation.R")
source("nicefigs.R")
obj_simul <- simulate_small_hts(n_simul, marg, obj.path)
source("packages.R")
install.packages("SGL")
source("packages.R")
install.packages("glmnet")
source("packages.R")
install.packages("igraph")
source("packages.R")
install.packages("igraph", dependencies=TRUE)
obj_simul <- simulate_small_hts(n_simul, marg, obj.path)
source("packages.R")
install.packages("igraph")
install.packages("igraph")
install.packages("igraph")
source("packages.R")
install.packages("plotrix")
source("packages.R")
install.packages("copula")
source("packages.R")
install.packages("copula")
install.packages("GSL")
install.packages("gsl")
install.packages("gsl", dependencies=TRUE)
install.packages("gsl")
gsl-devel
install.packages("gsl-devel")
install.packages("gsl", dependencies=TRUE)
