infoset {INFOSET}R Documentation

Procedure to find the most-left distribution set.

Description

Estimation of the vector of unknown parameters for the density functions associated with the two mixture components.

Usage

infoset(y)

Arguments

y

object of class "g_ret"

Value

An object of class "infoset" is a list containing the following components for the firse two iterations (k=2):

change.points

a vector of change points.

prior.probability

the a priori probabilities.

first.type.errors

the cumulative distribution functions associated with the leftmost component of the mixture.

second.type.errors

the cumulative distribution functions associated with the rightmost component of the mixture.

mean

the parameters (drift) of the left-hand component of the log-normal mixture.

sd

the parameters (volatility) of the left-hand component of the log-normal mixture.

References

Mariani, F., Polinesi, G., Recchioni, M. C. (2022). A tail-revisited Markowitz mean-variance approach and a portfolio network centrality. Computational Management Science, 19(3), 425-455.

Mariani, F., Ciommi, M., Chelli, F. M., Recchioni, M. C. (2020). An iterative approach to stratification: Poverty at regional level in Italy. Social Indicators Research, 1-31.

Examples


gross.ret<-as.data.frame(lapply(sample.data, g_ret))
infoset(gross.ret$ETF_1)


result<-NULL
for(i in 1:ncol(gross.ret)){
result[[i]]<-infoset(gross.ret[,i])
}
output<-matrix(unlist(result),12,ncol=ncol(gross.ret)) # output contains the information set
output<-t(output)
rownames(output)<-colnames(gross.ret)
colnames(output)<-c("ch_1","ch_2","priori_1","priori_2","first_1",
                "first_2","second_1","second_2","mean_1","mean_2","dev_1", "dev_2")
output<- as.data.frame(output)



############################################################
## EXAMPLE 1: Clustering ETFs
############################################################


library(colorspace)
library (dendextend)
group_label <- as.factor(asset.label$label)
d <- dist(output, method = 'euclidean')
hc_SIMS <- hclust(d, method = 'complete')
dend_SIMS <- as.dendrogram(hc_SIMS)
dend_SIMS <- color_branches(dend_SIMS, k = 4, col = c(1:4))
labels_colors(dend_SIMS) <-
       rainbow_hcl(5)[sort_levels_values(as.numeric(group_label)[order.dendrogram(dend_SIMS)])]
labels(dend_SIMS) <- paste(as.character(group_label)[order.dendrogram(dend_SIMS)],
       '(', labels(dend_SIMS), ')', sep = '')
dend_SIMS <- hang.dendrogram(dend_SIMS, hang_height = 0.001)
dend_SIMS <- assign_values_to_leaves_nodePar(dend_SIMS, 0.5, 'lab.cex')
dev.new()
old_par <- par(no.readonly = TRUE)
on.exit(par(old_par))
par(mar = c(1.8, 1.8, 1.8, 1))
plot(dend_SIMS, main = 'Complete linkage (the labels give the true ETF class)',
     horiz = TRUE, nodePar = list(cex = 0.007))
legend('topleft', legend = c('emerging equity Asia', 'emerging equity America',
                           'corporate bond', 'commodities', 'aggregate bond'),
             fill = c('#BDAB66', '#65BC8C', '#C29DDE', '#E495A5', '#55B8D0'), border = 'white')


############################################################
## EXAMPLE 2: Labelling ETFs
############################################################

ch <- output$ch_1
h <- list()
diff <- list()
n <- list()
a_int <- list()
hh <- list()
hh_p <- list()
expected_loss <- list()
p_loss<-list()
LR_cp <- list()
for(i in 1:ncol(gross.ret)) {
  h[[i]] <- hist(log(gross.ret[[i]]))
  diff[[i]] <- h[[i]]$breaks - ch[[i]]
  n[[i]] <- length(diff[[i]][diff[[i]]<0])
  a_int[[i]] <- h[[i]]$breaks[2] - h[[i]]$breaks[1]
  hh[[i]] <- h[[i]]$mids*h[[i]]$density*a_int[[i]]
  hh_p[[i]] <- h[[i]]$density*a_int[[i]]
  expected_loss[[i]] <- sum(hh[[i]][1:(n[[i]] - 1)]) +
    h[[i]]$density[n[[i]]]*(ch[[i]]-
                              h[[i]]$breaks[n[[i]]])*0.5*(ch[[i]] + h[[i]]$breaks[n[[i]]])
  p_loss[[i]]<-sum(hh_p[[i]][1:(n[[i]] - 1)]) +
    h[[i]]$density[n[[i]]]*(ch[[i]] - h[[i]]$breaks[n[[i]]])
  LR_cp[[i]] <- - (expected_loss[[i]]/p_loss[[i]])
}

############################################################
## EXAMPLE 3: Portfolio construction
############################################################


W <- list()
for(t in 0:15){
  W[[(t+1)]] = sample.data[(1 + t*125):(1290 + t*125), ]
}
ret <- list()
y <- list()
for(i in 1:ncol(sample.data)){
  for (t in 1:length(W)){
    ret[[t]] <- matrix(0,nrow = nrow(W[[1]]) - 1, ncol = ncol(sample.data))
    y[[t]] <- matrix(0, nrow = nrow(W[[1]]) - 1, ncol = ncol(sample.data))
  }
}

ch <- log(output$ch_1)
h <- list()
diff <- list()
n <- list()
a_int <- list()
hh <- list()
LR_cp <- list()
hh_p <- list()
p_loss <- list()
expected_loss <- list()

i <- ncol(sample.data)
for(t in 1:length(W)){
  h[[t]] <- vector('list', i)
  diff[[t]] <- vector('list', i)
  n[[t]] <- vector('list', i)
  a_int[[t]] <- vector('list', i)
  hh[[t]] <- vector('list', i)
  LR_cp[[t]]<- vector('list', i)
  hh_p[[t]] <- vector('list', i)
  p_loss[[t]] <- vector('list', i)
  expected_loss[[t]] <- vector('list', i)
}

for(i in 1:ncol(sample.data)){
  for (t in 1:length(W)){
    ret[[t]][,i] <- diff(log(W[[t]][, i]))
    y[[t]][,i] <- exp(ret[[t]][, i])
    y[[t]][,i] <- sort(y[[t]][, i]) ##gross return
    h[[t]][[i]] <- hist(log(y[[t]][, i]))
    diff[[t]][[i]] <- h[[t]][[i]]$breaks-ch[[i]]
    n[[t]][[i]] <- length(diff[[t]][[i]][diff[[t]][[i]] < 0])
    a_int[[t]][[i]] <- h[[t]][[i]]$breaks[2] - h[[t]][[i]]$breaks[1]
    hh[[t]][[i]] <- h[[t]][[i]]$mids*h[[t]][[i]]$density*a_int[[t]][[i]]
    hh_p[[t]][[i]] <- h[[t]][[i]]$density*a_int[[t]][[i]]
    expected_loss[[t]][[i]] <- sum(hh[[t]][[i]][1:(n[[t]][[i]] - 1)]) +
    h[[t]][[i]]$density[n[[t]][[i]]]*(ch[[i]] - h[[t]][[i]]$breaks[n[[t]][[i]]])*0.5*
   (ch[[i]] + h[[t]][[i]]$breaks[n[[t]][[i]]])
    p_loss[[t]][[i]] <- sum(hh_p[[t]][[i]][1:(n[[t]][[i]] - 1)]) +
    h[[t]][[i]]$density[n[[t]][[i]]]*(ch[[i]] - h[[t]][[i]]$breaks[n[[t]][[i]]])
    LR_cp[[t]][[i]] <- -(expected_loss[[t]][[i]]/p_loss[[t]][[i]])
  }
}

# ## Markowitz portfolio
library(quadprog)
library(Matrix)
r <- list()
meanret <- list()
COV_ret <- list()

for(t in 1: length(W)){
  r[[t]] <- matrix(colMeans(ret[[t]]))
  meanret[[t]] <- sum(r[[t]])/ncol(sample.data)
  COV_ret[[t]] <- cov(ret[[t]][(1289 - 252):1289, ])
  COV_ret[[t]] <- nearPD(COV_ret[[t]])$mat
}

tw <- length(W) - 1
n <- ncol(sample.data)
B <- list()
f <- list()
sol <- list()
w_ret <- list()
Pvalue_ret <- NULL
Pvalue_M <- list()
For6m_ret1 <- NULL
for(t in 1:tw){
  B[[t]] <- matrix(1, 1, n)
  B[[t]] <- rbind(B[[t]], t(r[[t]]), diag(n), -diag(n))
  f[[t]] <- c(1, meanret[[t]], rep(0, n), rep(-1, n))
  sol[[t]] <- solve.QP(Dmat = COV_ret[[t]], dvec = 0*r[[t]], Amat = t(B[[t]]),
        bvec = f[[t]], meq = 2)
  w_ret[[t]] <- round(sol[[t]]$solution,6)
  Pvalue_ret[t] <- sum(w_ret[[t]]*W[[t]][1289, ])
  Pvalue_M[[t]] <- (t(w_ret[[t]])%*%t(W[[t+1]][(1289 - 125):1289,]) -
                 Pvalue_ret[t])/Pvalue_ret[t]
  For6m_ret1[t] <- Pvalue_M[[t]][60]
}

# ## Combined Markowitz

for(t in 1:length(W)){
  LR_cp[[t]] <- matrix(unlist(LR_cp[[t]]), nrow = 1, ncol = ncol(sample.data))
}
B <- list()
f <- list()
sol <- list()
w_ret <- list()
Pvalue_ret <- NULL
Pvalue_C <- list()
For6m_ret2 <- NULL
lambda <- 0.0001
for(t in 1: tw){
  B[[t]] <- matrix(1, 1, n)
  B[[t]] <- rbind(B[[t]], t(r[[t]]), diag(n), -diag(n))
  f[[t]] <- c(1, meanret[[t]], rep(0, n), rep(-1, n))
  sol[[t]] <- solve.QP(Dmat = COV_ret[[t]], dvec = -lambda*LR_cp[[t]], Amat = t(B[[t]]),
                       bvec = f[[t]], meq = 2)
  w_ret[[t]] <- round(sol[[t]]$solution, 6)
  Pvalue_ret[t] <- sum(w_ret[[t]]*W[[t]][1289, ])
  Pvalue_C[[t]] <- (t(w_ret[[t]])%*%t(W[[t+1]][(1289-125):1289,]) -
                Pvalue_ret[t])/Pvalue_ret[t]
  For6m_ret2[t] <- Pvalue_C[[t]][60]
}

# ## Classical EDC
ret <- list()
y <- list()
for(i in 1:ncol(sample.data)){
  for(t in 1:length(W)){
    ret[[t]] <- matrix(0, nrow = nrow(W[[1]]) - 1, ncol = ncol(sample.data))
    y[[t]] <- matrix(0, nrow = nrow(W[[1]]) - 1, ncol = ncol(sample.data))
  }
}
for(i in 1:ncol(sample.data)){
  for (t in 1:length(W)){
    ret[[t]][, i] <- diff(log(W[[t]][, i]))
    y[[t]][, i] <- exp(ret[[t]][, i])
  }
}

W_out <- list()
for(t in 1:16){
  W_out[[(t)]] = ret[[t]][(1289 - 252):1289, ]
}
quant <- matrix(0, nrow = length(W), ncol = ncol(sample.data))
diff <- list()
for(t in 1:length(W)){
  for(i in 1:ncol(sample.data)){
    quant[t, i] <-quantile(as.numeric(W_out[[(t)]][, i]), probs = 0.05)
    diff[[t]] <- W_out[[(t)]] - colMeans(W_out[[(t)]])
    for (j in 1:length(W_out[[t]][, i])){
      if(W_out[[(t)]][j, i] > quant[t, i]){diff[[t]][j, i] = 0}
    }
  }
}

C_edc <- list()

for(t in 1:length(W)){
  aux <- matrix(0, nrow = ncol(sample.data), ncol = ncol(sample.data))
  for(i in 1:ncol(sample.data)){
    for(j in 1:ncol(sample.data)){
      aux[i, j] <- (mean(diff[[t]][, i]*diff[[t]][, j]))
    }
  }
  C_edc[[t]] <- aux
}

r <- list()
meanret <- list()
stdev <- list()
COV_edc <- list()

for(t in 1:length(W_out)){
  r[[t]] <- matrix(colMeans(ret[[t]]))
  meanret[[t]] <- sum(r[[t]])/n
  stdev[[t]] <- apply(W_out[[t]], 2, sd)
  stdev[[t]] <- matrix(stdev[[t]])
  COV_edc[[t]] <- nearPD(C_edc[[t]])$mat
}
B <- list()
f <- list()
sol <- list()
w_edc <- list()
Pvalue_edc <- NULL
Pvalue_EDC <- list()
For6m_edc1 <- NULL
for(t in 1: 15){
  B[[t]]<- matrix(1,1,n)
  B[[t]]<- rbind(B[[t]], t(r[[t]]), diag(n),-diag(n))
  f[[t]] <- c(1, meanret[[t]], rep(0, n),rep(-1, n))
  sol[[t]] <- solve.QP(Dmat = COV_edc[[t]], dvec = 0*r[[t]],
           Amat = t(B[[t]]), bvec = f[[t]], meq = 2)
  w_edc[[t]]<-round(sol[[t]]$solution, 6)
  Pvalue_edc[t]=sum(w_edc[[t]]*W[[t]][1289, ])
  Pvalue_EDC[[t]] = (t(w_edc[[t]])%*%t(W[[t+1]][(1289-125):1289, ]) -
               Pvalue_edc[t])/Pvalue_edc[t]
  For6m_edc1[t] <- Pvalue_EDC[[t]][60]
}

## Combined EDC
B <- list()
f <- list()
sol <- list()
w_edc <- list()
Pvalue_edc <- NULL
Pvalue_mod_EDC <- list()
For6m_mod_edc1 <- NULL

for(t in 1: 15){
  B[[t]]<- matrix(1,1,n)
  B[[t]]<- rbind(B[[t]], t(r[[t]]), diag(n),-diag(n))
  f[[t]] <- c(1, meanret[[t]], rep(0, n),rep(-1, n))
  sol[[t]] <- solve.QP(Dmat = COV_edc[[t]], dvec = lambda*LR_cp[[t]],
             Amat = t(B[[t]]), bvec = f[[t]], meq = 2)
  w_edc[[t]]<-round(sol[[t]]$solution, 6)
  Pvalue_edc[t]=sum(w_edc[[t]]*W[[t]][1289, ])
  Pvalue_mod_EDC[[t]] = (t(w_edc[[t]])%*%t(W[[t+1]][(1289-125):1289, ]) -
            Pvalue_edc[t])/Pvalue_edc[t]
  For6m_mod_edc1[t] <- Pvalue_mod_EDC[[t]][60]
}

sample_M <- NULL ## Classical Markowitz
sample_C <- NULL ## Combined Markowitz
sample_EDC <- NULL ## Classical EDC
sample_mod_EDC <- NULL ## Combined EDC
icont <- 0
count <- 1:15
for (t in count){
  for(j in 1:125){
    icont = icont + 1;
    sample_M[icont] = Pvalue_M[[t]][1, j]
    sample_C[icont] = Pvalue_C[[t]][1, j]
    sample_EDC[icont] = Pvalue_EDC[[t]][1, j]
    sample_mod_EDC[icont] = Pvalue_mod_EDC[[t]][1, j]
  }
}
dev.new()
old_par <- par(no.readonly = TRUE)
on.exit(par(old_par))
par(mfrow = c(1, 4))
boxplot(sample_M, ylim = c(-0.20, 0.15), outline = FALSE,
       main = expression(paste('Classical Markowitz')))
abline(h = mean(sample_M), col = 'red')
boxplot(sample_C, ylim = c(-0.20,0.15), outline = FALSE,
       main = expression(paste('Combined Markowitz')))
abline(h = mean(sample_C), col = 'red')
boxplot(sample_EDC, ylim = c(-0.20, 0.15), outline = FALSE,
       main = expression(paste('Classical EDC')))
abline(h = mean(sample_EDC), col = 'red')
boxplot(sample_mod_EDC, ylim = c(-0.20, 0.15), outline = FALSE,
       main = expression(paste('Combined EDC')))
abline(h = mean(sample_EDC), col = 'red')
dev.new()
par(mfrow = c(2, 1))
date<-as.Date(sample.data.ts$Date,format='%m/%d/%Y')
date_parz = seq(from = 1291, to = 3165, by = 64)
m = length(date_parz)
date_parz[m] = 3165
date_1 <- date[1291:3165]
date_2 <- date[date_parz]
matplot(date_1, cbind(sample_M, sample_C), type = 'l',
        col = c('red', 'black'), lty = c(2, 3),
        ylab = 'profit & loss', xlab = '',xaxt='n', ylim = c(-0.20, 0.15), cex.lab = 1.2)
axis(1, date_2, format(date_2, '%m/%Y'), cex.axis = .9, las = 2)
legend('bottomright', legend = c('Classical Markowitz', 'Combined Markowitz'),
       col=c('red','black'),lty = c(2, 3))
matplot(date_1, cbind(sample_EDC, sample_mod_EDC), type = 'l',
        col = c('brown', 'blue'), lty = c(3,1),
        ylab = 'profit & loss', xlab = '', xaxt = 'n', ylim = c(-0.20, 0.15), cex.lab = 1.2)
axis(1, date_2, format(date_2, '%m/%Y'), cex.axis = .9, las = 2)
legend('bottomright', legend = c('Classical EDC', 'Combined EDC'),
      col = c('brown','blue'), lty = c(3, 1))



[Package INFOSET version 4.0.6 Index]