ParavecToList <- function(para0.vec, np.vec){
  stopifnot(sum(np.vec)==length(unlist(para0.vec)))
  if(class(para0.vec)=="list"){
    para0.list <- para0.vec
  } else{
    startid <- c(0, np.vec[-length(np.vec)])
    para0.list <- lapply(1:length(np.vec), function(x) para0.vec[sum(startid[1:x]) + 1:np.vec[x]])
  }
  para0.list
}

loglikexi <- function(cmp.data, cmprsk, Rm, Xid=1){
  dist.type <- cmprsk$margins
  para.list <- cmprsk$margs.para.list
  para0 <- para.list[[Xid]]
  deltai <- as.numeric(cmp.data$delta==Xid)
  dtype.xi <- dist.type[Xid]
  fFRt <- Lttcmprsk_Prob(xcmp=cmp.data, cmprsk = cmprsk)$marg.prob
  llk <- sum(deltai*(log(fFRt$ftval[,Xid])-log(fFRt$Rtval[,Xid])) +
                       (1+Rm)*log(fFRt$Rtval[,Xid]))
  list(llk=llk, grad.llk=NULL)
} 

loglikeAll <- function(para0, cmprsk, cmp.data, Rm, log.para=FALSE, ...){
  if(log.para){
    para0 <- exp(unlist(para0))
  }
  # note para0 length should be equal to the total number in margins
  np.vec <- sapply(cmprsk$margs.para.list, length)
  para0.list <- ParavecToList(para0.vec = para0, np.vec=np.vec)
  cmprsk0 <- LttCmpRsk(margins = cmprsk$margins, para.list = para0.list)
  # print(cmprsk0$margs.para.list)
  # print(para0)
  loglike.list <- lapply(1:length(cmprsk0$margins), function(x) loglikexi(cmp.data = cmp.data,
                                                                          cmprsk = cmprsk0, 
                                                                          Xid=x, Rm=Rm))
  # print(sapply(loglike.list, function(x) x$llk))
  sum(sapply(loglike.list, function(x) x$llk))
}

loglikeAll.check <- function(para.list, cmprsk, cmp.data, Rm){
  d <- length(cmprsk$margins)
  np.vec <- sapply(cmprsk$margs.para.list, length)
  para.list <- ParavecToList(para0.vec = para.list, np.vec=np.vec)
  para.list <- LttCmpRsk(margins = cmprsk$margins, para.list = para.list)$margs.para.list
  delta.list <- lapply(1:d, function(x) as.numeric(cmp.data$delta==x))
  mi <- sapply(delta.list, sum)
  c1 <- sum(sapply(1:d, function(x) mi[x]*log(para.list[[x]]$scale*log(para.list[[x]]$shape))))
  c2 <- sum(1+Rm)*sum(sapply(1:d, function(x) log(para.list[[x]]$shape)-log(para.list[[x]]$shape-1)))
  ce <- lapply(1:d, function(x) log(para.list[[x]]$shape^(exp((-1)*cmp.data$tmin*para.list[[x]]$scale))-1))
  c3 <- sum(sapply(1:d, function(x) sum(delta.list[[x]]*(para.list[[x]]$scale*cmp.data$tmin +ce[[x]]))))
  cr <- lapply(1:d, function(x) log(1-para.list[[x]]$shape^((-1)*exp((-1)*cmp.data$tmin*para.list[[x]]$scale))))
  c4 <- sum(sapply(1:d, function(x) sum((1+Rm)*cr[[x]])))
  c1+c2-c3+c4
}

loglikeAll.gr <- function(para0, cmprsk, cmp.data, Rm, log.para=FALSE){
  d <- length(cmprsk$margins)
  if(log.para){
    para0 <- exp(para0)
    dp <- para0
  } else{
    dp <- rep(1,d)
  }
  # print(unlist(para.list))
  np.vec <- sapply(cmprsk$margs.para.list, length)
  para.list <- ParavecToList(para0.vec = para0, np.vec=np.vec)
  para.list <- LttCmpRsk(margins = cmprsk$margins, para.list = para.list)$margs.para.list
  gr <- unlist(lapply(1:d, function(x) loglikexi.gr(para= para.list[[x]], cmp.data=cmp.data,
                                                    Xid=x, Rm=Rm)))

  # print(gr)
  gr*dp
}


loglikexi.gr <- function(para, cmp.data, Rm,Xid=1){ #=rep(0, nrow(cmp.data)
  # shape, scale - gr[1] gr[2]
  deltai <- as.numeric(cmp.data$delta==Xid)
  mi <- sum(deltai)
  gr <- rep(0, length(para))
  wi <- para$shape^(exp((-1)*para$scale*cmp.data$tmin))
  wis <- wi^(-1)
  vi <- exp((-1)*para$scale*cmp.data$tmin)
  
  c1 <- mi/(para$shape*log(para$shape))
  c2 <- sum(1+Rm)/(para$shape*(para$shape-1))
  c3 <- (1/para$shape)*sum(deltai*vi/(wis-1))
  c4 <- (1/para$shape)*sum((1+Rm)*vi/(wi-1))
  gr[1] <- c1 - c2 + c3 + c4
  
  c1 <- mi/para$scale
  c2 <- sum(deltai*cmp.data$tmin)
  c3 <- log(para$shape)*sum((deltai*cmp.data$tmin*vi/(wis-1)))
  c4 <- log(para$shape)*sum((1+Rm)*cmp.data$tmin*vi/(wi-1))
  gr[2] <- c1 - c2 - c3 - c4 
  
  # print(gr)
  gr
}

loglikexi.hessian <- function(para, cmp.data, Rm, Xid=1){
  deltai <- as.numeric(cmp.data$delta==Xid)
  mi <- sum(deltai)
  hs <- matrix(0, ncol=length(para), nrow = length(para))
  
  wi <- para$shape^(exp((-1)*para$scale*cmp.data$tmin))
  wis <- wi^(-1)
  vi <- exp((-1)*para$scale*cmp.data$tmin)
  n <- sum(1+Rm)
  
  c1 <- ((-1)/para$shape^2)*(mi*(1+log(para$shape))/(log(para$shape)^2)+
                               (n*(1-2*para$shape))/(para$shape-1)^2)
  c2 <- ((-1)/para$shape^2)*sum(deltai*vi/(wis-1))
  c3 <- (1/para$shape^2)*sum(deltai*vi^2/(wi*(wis-1)^2))
  c4 <- ((-1)/para$shape^2)*sum((1+Rm)*vi/(wi-1))
  c5 <- ((-1)/para$shape^2)*sum((1+Rm)*vi^2/(wis*(wi-1)^2))
  hs[1,1] <- c1 + c2 + c3 + c4 + c5
  
  c1 <- (-1)*mi/para$scale^2
  c2 <- sum(deltai*cmp.data$tmin^2*log(para$shape)*vi/(wis-1))
  c3 <- sum(deltai*cmp.data$tmin^2*log(para$shape)^2*vi^2/(wi*(wis-1)^2))
  c4 <- sum((1+Rm)*cmp.data$tmin^2*log(para$shape)*vi/(wi-1))
  c5 <- (-1)*sum((1+Rm)*cmp.data$tmin^2*log(para$shape)^2*vi^2/(wis*(wi-1)^2))
  hs[2,2] <- c1 + c2 + c3 + c4 + c5
  
  
  c01 <- 1+(vi*log(para$shape))/(wi*(wis-1))
  c02 <- 1-(vi*log(para$shape))/(wis*(wi-1))
  c1 <- ((-1)/para$shape)*sum(deltai*(cmp.data$tmin*vi*c01)/(wis-1))
  c2 <- ((-1)/para$shape)*sum(cmp.data$tmin*vi*(1+Rm)*c02/(wi-1))
  hs[1,2] <- hs[2,1] <- c1 + c2
  hs
}


loglikeAll.hessian <- function(para.list, cmprsk, cmp.data, Rm){
  d <- length(cmprsk$margins)
  np.vec <- sapply(cmprsk$margs.para.list, length)
  para.list <- ParavecToList(para0.vec = para.list, np.vec=np.vec)
  para.list <- LttCmpRsk(margins = cmprsk$margins, para.list = para.list)$margs.para.list
  hs.list <- lapply(1:length(cmprsk$margins), 
                    function(x)  loglikexi.hessian(para=para.list[[x]],
                                                   cmp.data=cmp.data, Rm=Rm, Xid=x))
  hsmat <- as.matrix(Matrix::bdiag(hs.list))
  hsmat
}


loglikeAll.single  <- function(parai, para0, cmprsk, cmp.data, Rm, para.id=1, log.para=FALSE){
  paranew <- para0
  paranew[para.id] <- parai
  y <- loglikeAll(para0=paranew, cmprsk=cmprsk, cmp.data=cmp.data, Rm=Rm, log.para=log.para)
  y
}

loglikeAll.single.gr  <- function(parai, para0, cmprsk, cmp.data, Rm, para.id=1, log.para=FALSE){
  paranew <- para0
  paranew[para.id] <- parai
  y <- loglikeAll.gr(para0=paranew, cmprsk=cmprsk, cmp.data=cmp.data, Rm=Rm, log.para=log.para)
  y[para.id]
}

loglikeAll.single.pl  <- function(parai, para0, cmprsk, cmp.data, Rm, 
                                  varM=diag(length(para0)), parai0=1,
                                  para.id=1, log.para=FALSE){
  paranew <- para0
  paranew[para.id] <- parai
  y <- loglikeAll(para0=paranew, cmprsk=cmprsk, cmp.data=cmp.data, Rm=Rm, log.para=log.para)
  if(length(para.id) > 1){
    a <- t(as.matrix(parai-parai0))%*%solve(varM[para.id, para.id])%*%(as.matrix(parai-parai0))
  } else{
    a <- (parai-parai0)^2/varM[para.id, para.id]
  }
  y - a
}