pair_risk_contribution report is out of date about pairs HOT 9 OPEN

plot_tsne_grid<-function(fn,tsne,pictures){
  s<-(floor(sqrt(length(pictures)))+1)^2
  k<-sqrt(s)
  m<-diag(k)
  gx<-as.vector(col(m))
  gy<-as.vector(row(m))
  tx<-rescale(tsne$Y[,1],range(gx))
  ty<-rescale(tsne$Y[,2],range(gy))
  tsnex<-matrix(tx,ncol=1)[,rep(1,length(gx))]
  tsney<-matrix(ty,ncol=1)[,rep(1,length(gy))]
  gridx<-matrix(gx,nrow=1)[rep(1,length(tx)),]
  gridy<-matrix(gy,nrow=1)[rep(1,length(ty)),]
  dx<-(tsnex-gridx)^2
  dy<-(tsney-gridy)^2
  d<-dx+dy
  t2g <- solve_LSAP(d)
  par(mai=c(0,0,0,0))
  plot(gx,gy,col="white",axes=FALSE,xlab="",ylab="",main="")
  for(i in seq_along(pictures))rasterImage(
    image=pictures[[i]][[fn]],
    xleft=gx[t2g[i]]-0.49,
    ybottom=gy[t2g[i]]-0.49,
    xright=gx[t2g[i]]+0.49,
    ytop=gy[t2g[i]]+0.49,
    interpolate=TRUE
  )
  abline(
    h=setdiff(unique(gx),range(gx)[1])-0.5,
    v=setdiff(unique(gy),range(gy)[1])-0.5,
    col=rgb(0.5,0.5,0.5,0.5)
  )
}

split_plot<-function(
  x,
  f,
  factor_state_fun=sign,
  state_col=rainbow(length(all_states),alpha=0.5),
  cex=2
){
  
  all_states<-sort(unique(factor_state_fun(f)))
  #state_col<-rainbow(length(all_states),alpha=0.5)
  states<-match(factor_state_fun(f),all_states)
  the_split<-data.table(
    state=states,
    value=x,
    factor=f,
    x=do.call(c,split(seq_along(states),states)),
    y=do.call(c,mapply(cumsum,split(x,states),SIMPLIFY=FALSE)),
    col=do.call(c,split(state_col[states],states))
  )
  par(mai=c(0.1,0.1,0.1,0.1))
  plot(
    x=the_split$x,
    y=the_split$y,
    col=the_split$col,
    pch=19,
    cex=cex,
    axes=FALSE,
    xlab="",
    ylab=""
  )
  par(mai=c(1.02,0.82,0.82,0.42))
  the_split
}


pms<-colnames(manager_local_pnl)
fs<-c(
  "SMX Index","UKX Index","MCX Index",
  "SXXP Index",
  "MSEEMOMO Index","MSEEGRW Index","MSEEVAL Index",
  "USO US Equity","EEM US Equity","TLT US Equity",
  "COINXBE SS Equity"
)
pic_w<-paste0(round(18/(length(pms)+1),digits=1),"cm")
pic_h<-paste0(round(21/length(fs),digits=1),"cm")
log_code(split_pics<-data.table(
    factors=sub("( Index$)|( Equity$)","",fs),
    t(structure(outer(pms,fs,FUN=Vectorize(function(pm,fac){
      res<-make_plot(
        x0<-split_plot(
          manager_local_pnl[,pm],
          factor_local_tret[,fac],
          state_col=c(rgb(1,0,0,0.5),rgb(0.2,0.2,0.2,0.5),rgb(0,1,0,0.5))
        ),
        width=pic_w,
        height=pic_h
      )
      res
    })),dimnames=list(pms,gsub(" Index$","",fs))))
))
split_align=paste0("m{",pic_w,"}")

# vol trajectories are computed by taking costituents largest vol first
tri<-function(n,d=1,s=1)(s*row(diag(n))<s*col(diag(n)))+d*diag(n)
log_code(vols<-weights*(cbind(apply(x,2,sd))[,rep(1,ncol(weights))]))
log_code(vol_ord<-structure(apply(-vols,2,.%>%rank(ties="f")),dimnames=dimnames(vols)))
log_code(res<-mapply(function(ptf){
  a1<-(weights[,rep(ptf,nrow(weights))]*diag(nrow(vols))[vol_ord[,ptf],]%*%tri(nrow(vols)))
  a2<-total_gross*a1%*%diag(1/colSums(a1))
  apply(x%*%a2,2,sd)
},ptf=colnames(vol_ord))%>%
{ rownames(.)<-paste0("vol_rank_",1:nrow(.)); . })

volatility_trajectory<-function(
  returns,
  ptf
){
  vol=ptf*apply(returns[,names(ptf)],2,sd)
  vol_rank=rank(vol,ties.method="first")
  weight_matrix <- cbind(ptf=ptf)[,rep(1,length(ptf))]
  mask_matrix <- diag(length(vol))[vol_rank,] %*% tri(length(vol))
  trajectory_matrix <- weight_matrix * mask_matrix
  normalized_trajectory_matrix <- trajectory_matrix %*% diag(sum(ptf)/colSums(trajectory_matrix))
  apply(returns%*%normalized_trajectory_matrix,2,sd)
}