mlxR: Simulation of Longitudinal Data

translateIOV <- function(model, occ.name, nocc, output, iov0, cat0=NULL) {
  
  if (length(cat0)==0)  
    cat0 <- NULL
  sections <- sectionsModel(model)
  sm  <-  splitModel(model, sections)
  lines <- c()
  i.iov <- iov0
  o.iov <- addiov(i.iov, output)
  
  cat0.name <-  unlist(lapply(cat0, function(x) x$name))
  # if ("OCC" %in% cat0.name)
  #   rem.name <- c("occ","socc", "sOCC")
  # else
  rem.name <- c("occ","socc", "OCC","sOCC")
  if (!is.null(cat0))
    rem.name <- unique(c(rem.name,paste0("s",cat0.name)))
  
  i.cov <- which(sapply(sm, function(ch)  ch$name=="[COVARIATE]"))
  d.iov <- c.iov <- v.iov <- NULL
  add.iov <- FALSE
  if (length(i.cov)>0) {
    sec.cov <- splitSection(sm[[i.cov]])
    #    rem.name <- c(occ.name)
    #    rem.name <- c(occ.name, unlist(lapply(cat0, function(x) x$name)))
    r0.cov <- iovin(sec.cov$input, NULL, i.iov, nocc, sec.cov$name, cat0, rem.name=rem.name)
    i.iov <- r0.cov$iov
    lines.cov <- r0.cov$lines
    #var.iov <- v.iov
    if (length(sec.cov$blocks)) {
      for (k in (1:length(sec.cov$blocks))) {
        if (identical(sec.cov$blocks[k],'EQUATION:')) {
          rk.cov <- ioveq(sec.cov$lines[[k]], i.iov, d.iov, nocc)
        } else {
          rk.cov <- iovdef(sec.cov$lines[[k]], i.iov, nocc)
          d.iov <- rk.cov$d.iov
        }
        c.iov <- rk.cov$iov
        #        var.iov <- unique(c(var.iov, v.iov))
        lines.cov <- c(lines.cov, rk.cov$lines)
      }
    }
    if (!is.null(d.iov) | !is.null(i.iov)) {
      add.iov <- TRUE
      lines <- c(lines,"",lines.cov)
    } else {
      lines <- c(lines,"",sm[[i.cov]]$lines)
    }
    
    o.iov <- unique(c(o.iov,addiov(c.iov, output)))
  }
  
  i.ind <- which(sapply(sm, function(ch)  ch$name=="[INDIVIDUAL]"))
  if (length(i.ind)>0) {
    sec.ind <- splitSection(sm[[i.ind]])
    #    u.iov <- setdiff(unique(c(c.iov, o.iov)), i.iov)
    u.iov <- c.iov
    u.iov <- setdiff(c.iov, cat0.name)
    r0.ind <- iovin(sec.ind$input, u.iov, i.iov, nocc, sec.ind$name, cat0, rem.name=rem.name)
    #    v.iov <- r0.ind$iov
    v.iov <- unique(c(u.iov, i.iov))
    o.iov <- unique(c(o.iov,addiov(c.iov, output)))
    lines.ind <- r0.ind$lines
    for (k in (1:length(sec.ind$blocks))) {
      if (identical(sec.ind$blocks[k],'EQUATION:')) {
        rk.ind <- ioveq(sec.ind$lines[[k]], v.iov, d.iov, nocc)
        v.iov <- rk.ind$iov
      } else {
        rk.ind <- iovdef(sec.ind$lines[[k]], v.iov, nocc)
        d.iov <- rk.ind$d.iov
        v.iov <- rk.ind$iov
      }
      #var.iov <- unique(c(var.iov, v.iov))
      lines.ind <- c(lines.ind, rk.ind$lines)
    }
    if (!is.null(d.iov)) {
      add.iov <- TRUE
      lines <- c(lines,"",lines.ind)
    } else {
      lines <- c(lines,"",sm[[i.ind]]$lines)
    }
  }
  
  i.long <- which(sapply(sm, function(ch)  ch$name=="[LONGITUDINAL]"))
  if (length(i.long)>0) {
    if (!is.null(v.iov) & add.iov) {
      sec.long <- splitSection(sm[[i.long]])
      u.iov <- unique(c(i.iov,o.iov))
      long.lines <- iovinlong(sec.long$input, v.iov, u.iov, nocc, sec.long$name, occ.name)
      if (length(v.iov)==length(d.iov)) {
        r1.long <- iovseclong(sec.long, v.iov, d.iov, u.iov, nocc, occ.name)
        #    var.iov <- unique(c(var.iov, r0.long$iov))
        lines <- c(lines,"",long.lines,r1.long$lines)
      }
    } else {
      lines <- c(lines,"",sm[[i.long]]$lines)
    }
  }
  model <- "tempiov_model.txt"
  write(lines,model)
  return(list(model=model, iov=unique(c(o.iov,v.iov,i.iov)), occ.name=occ.name, cat=cat0))
}

regstr1 <-function(expr,str) {
  # find in a set of equations (str) which variables are function of variable expr
  strb <- paste0(" ",str," ")
  #sep <- "([+-\\*\\^\\(\\)\\/[:space:]])"
  sep <- "([^[:digit:]_])"
  ig  <- grep(paste0(sep,expr,sep),strb)
  newv <- gsub("\\=.*","",str[ig])
  return(newv)
}

repstr1 <-function(expr,x,str) {  
  # add x to ALL the occurences of expr (and only expr) in str
  str <- paste0(" ",str," ")
  #sep <- "([+-\\*\\^\\(\\)\\/[:space:]^[:digit:]_])"
  sep <- "([^[:digit:]_])"
  str <- gsub(paste0(sep,expr,sep),paste0("\\1",expr,x,"\\2"),str)
  str <- gsub("^\\s+|\\s+$", "", str)
  return(str)
}


line2field <- function(str) {
  if (length(str)>1)
    str <- strmerge(str, 0)
  str <- gsub(" ","",str)
  rout <- list()
  for (k in (1:length(str))) {
    strk <- str[k]
    strk <- gsub("no-variability","sd=0",strk)
    r <- list(name=sub("\\=.*","",strk))
    i1 <- regexpr("\\{",strk)
    i2 <- tail(gregexpr("\\}",strk)[[1]],n=1)
    strk <- substr(strk,i1+1,i2-1)
    sp <- strsplit(strk,",")[[1]]
    sp <- strmerge(sp, 1)
    fields <- sub("\\=.*","",sp)
    rv <- sub(".*\\=","",sp)
    nv <- lapply(rv, function(x) sum(gregexpr("\\{",x)[[1]]>0))
    lrv <- as.list(rv)
    
    iv1 <- which(nv==1)
    if (length(iv1)>0) {
      riv1 <- gsub(".*?\\{(.*?)\\}.*", "\\1", rv[iv1])
      lrv[iv1] <- strsplit(riv1,",")
    }
    iv2 <- which(nv>=2)
    if (length(iv2)>0) {
      for (i2 in (iv2)) {
        rvi2 <- rv[i2]
        i1 <- regexpr("\\{",rvi2)
        i2 <- tail(gregexpr("\\}",rvi2)[[1]],n=1)
        rvi2 <- substr(rvi2,i1+1,i2-1)
        j1 <- -1
        j2 <- -1
        ni2 <- nchar(rvi2)
        lrvi2 <- c()
        while (j2>=j1 && j2 <ni2) {
          j1 <- j2+2
          if (substr(rvi2,j1,j1)=="{") 
            j2 <- regexpr("\\}",substr(rvi2,j1+1,ni2))+j1
          else 
            j2 <- regexpr("\\,",substr(rvi2,j1+1,ni2))+j1-1
          if (j2>=j1)
            lrvi2 <- c(lrvi2, substr(rvi2,j1,j2))
          else
            lrvi2 <- c(lrvi2, substr(rvi2,j1,ni2))
        }
        lrv[[iv2]] <- lrvi2
      }
    }
    
    r$fields <- lrv
    names(r$fields) <- fields
    rout[[k]] <- r
  }
  if (length(rout)==1)  rout <- rout[[1]]
  return(rout)
}

field2line <- function(r) {
  #write line(s) with fields
  nr <- length(r)
  #if (nr==1) r <- list(r)
  lines <- vector(length=nr)
  for (k in (1:nr)) {
    rk <- r[[k]]
    nk <- names(rk$fields)
    mk <- sapply(rk$fields,length)
    ik <- which(mk>1)
    rk$fields[ik] <- sapply(rk$fields[ik], function(x) paste0("{",paste(x,collapse=","),"}"))
    uk <- paste(nk,unlist(rk$fields),sep="=") 
    lines[k] <- paste0(rk$name,"={",paste(uk, collapse=","),"}")
  }
  return(lines)
}

strmerge <- function(str1, op=0) {
  n <- length(str1)
  str2 <- c()
  idx <- 0
  while (idx<n) {
    idx <- idx + 1
    si <- str1[idx]
    n1 <- sum(gregexpr("\\{",si)[[1]]>0)
    n2 <- sum(gregexpr("\\}",si)[[1]]>0)
    while(n1 > n2) {
      idx <- idx+1
      if (identical(substr(si,nchar(si),nchar(si)),",") | identical(substr(si,nchar(si),nchar(si)),"{"))
        si <- paste0(si,str1[idx])
      else
        si <- paste(si,str1[idx],sep=",")
      n1 <- sum(gregexpr("\\{",si)[[1]]>0)
      n2 <- sum(gregexpr("\\}",si)[[1]]>0)
    }
    str2 <- c(str2, si)
  }
  
  list1 <- NULL
  for (idx in (1:length(str2))) {
    si <- str2[idx]
    if (identical(substr(si,nchar(si),nchar(si)),"="))
      list1 <- c(list1, idx)
  }
  if (length(list1)>0) {
    for (idx in list1)
      str2[idx] <- paste0(str2[idx],str2[idx+1])
    str2 <- str2[-(list1+1)]
  }
  
  if (op==1) {
    n <- length(str2)
    str3 <- c()
    idx <- 0
    while (idx<n) {
      idx <- idx + 1
      si <- str2[idx]
      if (!identical(si, "no-variability")) {
        while (!grepl("=",si)) {
          idx <- idx + 1
          si <- paste(si, str2[idx], sep=",")
        }
      }
      str3 <- c(str3, si)
    }
    str3 <- gsub(",}","}",str3)
    return(str3) 
  } else {
    str2 <- gsub(",}","}",str2)
    return(str2)
  }
}

splitSection  <-  function(section) {
  #   Split a section of a model into multiple blocks (input/equation/definition) 
  
  lines <- section$lines
  i.input   = grep("input=",lines, fixed=TRUE)[1]
  i.eq   = grep("EQUATION:",lines, fixed=TRUE)
  i.def   = grep("DEFINITION:",lines, fixed=TRUE)
  i.pk   = grep("PK:",lines, fixed=TRUE)
  is <- sort(c(i.pk,i.eq,i.def))
  is <- c(is, length(lines)+1)
  if (!is.na(i.input))
    input <- lines[i.input:(is[1]-1)]
  else
    input <- NULL
  bt <- c()
  bc <- list()
  if (length(is)>1) {
    for (k in (1:(length(is)-1))) {
      if (regexpr("EQUATION:",lines[is[k]], fixed=TRUE)==1)
        bt <- c(bt, "EQUATION:")
      else if (regexpr("DEFINITION:",lines[is[k]], fixed=TRUE)==1)
        bt <- c(bt, "DEFINITION:")
      else
        bt <- c(bt, "PK:")
      if (is[k+1]-is[k] >1)
        bc[[k]] <- lines[(is[k]+1):(is[k+1]-1)]
      else
        bc[[k]] <- ""
    }
  }
  return(list(name=section$name, input=input, blocks=bt, lines=bc))
}

iovin <- function(lines, c.iov=NULL, v.iov=NULL, nocc, name, cat=NULL, rem.name=NULL) {
  # duplicates the list of variables with IOV in the input list
  
  if (!is.null(rem.name)) {
    vc <- sub("\\=.*","",lines)
    lines <- lines[!(vc %in% rem.name)]
    foo <- "foo123456"
    lines <- gsub(paste0(rem.name,collapse="|"),foo,lines)
    lines <- gsub(paste0(",",foo),"",lines)
    lines <- gsub(paste0(foo,","),",",lines)
    lines <- gsub("\\{,","\\{",lines)
    lines <- gsub(",\\}","\\}",lines)
    lines <- gsub(paste(paste0("=",rem.name),collapse="|"),"=",lines)
    lines <- lines[lines!="input="]
    lines <- lines[lines!=paste0("input=",foo)]
    gl <- grep("\\{\\}",lines)
    if (length(gl)>0)
      lines <- lines[-gl]
  }
  
  if (length(lines)==0)
    return(list(iov=NULL, lines=name))
  
  
  suffix <- "_iov"
  sep <- "([\\,\\{\\}])"
  vi <- c()
  
  for (expr in v.iov)
    if (length(grep(expr, lines))==0)
      rem.name <- c(rem.name, expr)
  v.iov <- setdiff(v.iov,rem.name)
  
  l.input <- grep("input", lines)
  if (length(v.iov)==1 && l.input %in% grep(v.iov,lines) && length(grep("\\{", lines[l.input]))==0)
    lines[l.input] <- paste0("input={",v.iov,"}")
  
  for (expr in c.iov) {
    nexpr0 <- paste0(expr,"0")
    nexpr1 <- paste0("eta_",expr,suffix,1:nocc,collapse=",")
    nexpr <- paste(nexpr0, nexpr1, sep=",")
    if (any(regexpr(paste0(sep,expr,sep),lines)>0)) {
      vi <- c(vi, expr)
      lines <- gsub(paste0(sep,expr,sep),paste0("\\1",nexpr,"\\2"),lines)
    } else {
      lines <- c(lines, paste0("input={",nexpr,"}"))
    }
  }
  
  for (expr in v.iov) {
    nexpr <- paste0(expr,suffix,1:nocc,collapse=",")
    if (any(regexpr(paste0(sep,expr,sep),lines)>0))
      vi <- c(vi, expr)
    lines <- gsub(paste0(sep,expr,sep),paste0("\\1",nexpr,"\\2"),lines)
  }
  vc <- sub("\\=.*","",lines)
  
  if (!is.null(c(c.iov,v.iov)))
    lines <- lines[!(vc %in% c(c.iov,v.iov))]
  if (!is.null(cat)) {
    for (k in (1: length(cat))) {
      if (!(cat[[k]]$name %in% rem.name)) {
        if (!(cat[[k]]$name %in% vi))
          lines <- c(lines, paste0("input = {", paste0(cat[[k]]$name,suffix,1:nocc,collapse=","),"}"))
        for (ko in (1:nocc)) {
          lo <- paste0(cat[[k]]$name,suffix,ko,"={type=categorical,categories={",paste(cat[[k]]$categories,collapse = ","),"}}")
          lines <- c(lines, lo)
        }
      }
    }
  }
  return(list(iov=vi, lines=c(name,lines)))
}


iovinlong <- function(lines, v.iov, o.iov, nocc, name, occ.name) {
  # adapts the input of section LONGITUDINAL for IOV 
  suffix <- "_iov"
  sep <- "([\\,\\{\\}])"
  #  vi <- c()
  
  for (expr in v.iov) {
    nexpr0 <- paste0(expr,"0")
    nexpr1 <- paste0("eta_",expr,suffix,1:nocc,collapse=",")
    nexpr <- paste(nexpr0, nexpr1, sep=",")
    if (any(regexpr(paste0(sep,expr,sep),lines)>0))
      lines <- gsub(paste0(sep,expr,sep),paste0("\\1",nexpr,"\\2"),lines)
    else
      lines <- c(lines, paste0("input={",nexpr,"}"))
    #    vi <- c(vi, expr)
  }
  for (expr in o.iov) {
    nexpr <- paste0(expr,suffix,1:nocc,collapse=",")
    if (any(regexpr(paste0(sep,expr,sep),lines)>0))
      lines <- gsub(paste0(sep,expr,sep),paste0("\\1",nexpr,"\\2"),lines)
    else
      lines <- c(lines, paste0("input={",nexpr,"}"))
    #    vi <- c(vi, expr)
  }
  lines <- c(lines, paste0("input={",occ.name,"}"), paste0(occ.name,"={use=regressor}"))
  return(lines=c(name,lines))
}


ioveq <- function(lines, v.iov=NULL, d.iov=NULL, nocc) {
  # duplicates lines in a set of equation creating new variables for each occasion
  
  new.lines <- c()
  if (length(d.iov)>0) {
    for (i in 1:length(v.iov)) {
      vi <- v.iov[i]
      di <- d.iov[i]
      vi0 <- paste0(vi,"0")
      vis <- paste0(vi,"_iov")
      vie <- paste0("eta_",vi,"_iov")
      for (k in (1:nocc)) {
        if (tolower(di)=="normal") {
          nl <- paste0(vis,k," = ",vi0," + ",vie,k)
        } else if (tolower(di)=="lognormal") {
          nl <- paste0(vis,k," = ",vi0," * exp(",vie,k,")") 
        } else if (tolower(di)=="logitnormal") {
          nl <- paste0(vis,k," = 1/(1+exp(-logit(",vi0,") + ",vie,k,"))")
        } else {
          stop("IOV is only possible with distributions normal, lognormal, logitnormal", call.=FALSE)
        }
        new.lines <- c(new.lines, nl)
      }
    }
  }
  
  
  listc <- c()
  for (kc in (1: length(v.iov))) {
    listk <- testk <- v.iov[kc]
    while (length(testk)>0) {
      listk <- unique(c(listk,regstr1(testk[1],lines)))
      testk <- unique(c(testk,regstr1(testk[1],lines)))
      testk <- testk[-1] 
    }
    listc <- unique(c(listc, listk))
  }
  new.eq <- c()
  for (ko in (1:nocc)) {
    smek <- lines
    for (exprk in listc) {
      smek <- repstr1(exprk,paste0("_iov",ko),smek)
    }
    new.eq <- c(new.eq, smek)
  }
  new.eq <- unique(new.eq)
  return(list(iov=listc,lines=c("EQUATION:",new.lines,new.eq)))
}

iovseclong <- function(sec, v.iov=NULL, d.iov=NULL, o.iov=NULL, nocc, occ.name) {
  # add a block EQUATION to section LONGITUDINAL for IOV 
  
  suffix <- "_iov"
  new.lines <- c()
  if (!is.null(v.iov)) {
    new.lines <- c("EQUATION:",paste0("if ",occ.name,"==1"))
    for (ko in (1:nocc)) {
      for (vi in v.iov) {
        new.lines <- c(new.lines, paste0("   eta_",vi,"=",paste0("eta_",vi,suffix,ko)))
      }
      for (vi in o.iov) {
        new.lines <- c(new.lines, paste0("   ",vi,"=",paste0(vi,suffix,ko)))
      }
      new.lines <- c(new.lines, paste0("elseif ",occ.name,"==",ko+1))
    }
    new.lines[length(new.lines)] <- "end"
  }
  for (i in 1:length(v.iov)) {
    vi <- v.iov[i]
    di <- d.iov[i]
    if (tolower(di)=="normal") {
      nl <- paste0(vi," = ",vi,"0 + eta_",vi)
    } else if (tolower(di)=="lognormal") {
      nl <- paste0(vi," = ",vi,"0 * exp(eta_",vi,")") 
    } else if (tolower(di)=="logitnormal") {
      nl <- paste0(vi," = 1/(1+exp(-logit(",vi,"0) + eta_",vi,"))")
    } else {
      stop("IOV is only possible with distributions normal, lognormal, logitnormal", call.=FALSE)
    }
    new.lines <- c(new.lines, nl)
  }
  for (k in (1:length(sec$blocks))) {
    new.lines <- c(new.lines,sec$blocks[k],sec$lines[[k]])
  }
  return(list(lines=new.lines))
}

iovdef <- function(lines, v.iov=NULL, nocc) {
  # define IOV by creating two blocks DEFINITION
  
  suffix <- "_iov"
  lines <- gsub(",mean=",",reference=",lines)
  lines <- gsub(",prediction=",",reference=",lines)
  lines <- gsub(",typical=",",reference=",lines)
  iop.sd <- (length(grep("var=",lines))==0) 
  fields <- line2field(lines)
  if (length(lines)==1) fields <- list(fields)
  
  i.iov <- which(sapply(fields, function(x) !is.null(x$fields$varlevel)))
  vcv <- list()
  for (k in (1:length(fields))) {
    icv <- match(fields[[k]]$fields$covariate,v.iov)
    icv <- icv[!is.na(icv)]
    vcv[[k]] <- v.iov[icv]
    if (length(icv)>0) 
      i.iov <- unique(c(i.iov, k))
  }
  if (length(i.iov)>0) {
    v.iov <- sapply(fields[i.iov], function(x) x$name)
    d.iov <- sapply(fields[i.iov], function(x) x$fields$distribution)
    for (iv in i.iov) {
      if (identical(fields[[iv]]$fields$varlevel,"id*occ")) {
        if (iop.sd)
          fields[[iv]]$fields$sd <- c(0,fields[[iv]]$fields$sd)
        else
          fields[[iv]]$fields$var <- c(0,fields[[iv]]$fields$var)
      }
    }
    f1 <- fields
    for (iv in i.iov) {
      f1[[iv]]$name <- paste0(f1[[iv]]$name,"0")
      f1[[iv]]$fields$varlevel <- NULL
      f1[[iv]]$fields$covariate <- NULL
      f1[[iv]]$fields$coefficient <- NULL
      if (iop.sd)
        f1[[iv]]$fields$sd <- f1[[iv]]$fields$sd[1]
      else
        f1[[iv]]$fields$var <- f1[[iv]]$fields$var[1]
    }
    line1 <- field2line(f1)
    
    f2 <- fields
    for (iv in i.iov) {
      f2[[iv]]$fields$varlevel <- NULL
      f2[[iv]]$fields$reference <- 0
      f2[[iv]]$fields$distribution <- "normal"
      if (iop.sd)
        f2[[iv]]$fields$sd <- ifelse(is.na(f2[[iv]]$fields$sd[2]),0,f2[[iv]]$fields$sd[2])
      else
        f2[[iv]]$fields$var <- ifelse(is.na(f2[[iv]]$fields$var[2]),0,f2[[iv]]$fields$var[2])
    }
    f2o <- f2[i.iov]
    f2 <- list()
    for (ko in (1:nocc)) {
      for (k in 1:length(i.iov))  {
        f2o[[k]]$name <- paste0("eta_",v.iov[k],suffix,ko)
        if (length(vcv)>0) {
          vcvk <- vcv[[i.iov[k]]]
          if (length(vcvk)>0) {
            fck <- fields[[i.iov[k]]]$fields$covariate
            for (j in (1:length(vcvk)))
              fck <- gsub(vcvk[j],paste0(vcvk[j],suffix,ko),fck)
            f2o[[k]]$fields$covariate <- fck
          }
        }
      }
      f2 <- c(f2,f2o)
    }
    line2 <- field2line(f2)
    new.lines <- c("DEFINITION:",line1,line2)
  } else {
    new.lines <- c("DEFINITION:", lines)
    d.iov <- NULL
  }
  new.lines <- gsub("no-variability=no-variability","no-variability",new.lines)
  
  #---   transform correlations at the iov level into correlations at the iiv level
  l.cor <- grep("id\\*occ",new.lines)
  if (length(l.cor)>0) {
    lk.cor <- NULL
    for (i in l.cor) {
      li.cor0 <- new.lines[i]
      li.cor0 <- gsub("id\\*occ", "id", li.cor0)
      vi1 <- gregexpr("\\(", li.cor0)[[1]] 
      vi2 <- gregexpr("\\)", li.cor0)[[1]]
      nv1 <- length(vi1)
      li.cor <- NULL
      for (ko in (1:nocc)) {
        li.cork <- li.cor0
        for (ji in seq_len(nv1)) {
          i1 <- vi1[nv1-ji+1]
          i2 <- vi2[nv1-ji+1]
          str12 <- substr(li.cork, start=i1, stop=i2)
          isep <- regexpr(",", str12) 
          viov <- c(substring(str12,first=2,last=isep-1),substring(str12,first=isep+1, last=nchar(str12)-1))
          li.cork <- gsub(str12,paste0("(eta_",viov[1],suffix,ko,", ","eta_",viov[2],suffix,ko,")"),li.cork, fixed=TRUE)
        }
        lk.cor <- c(lk.cor, li.cork )
      }
    }
    new.lines <- new.lines[-l.cor] 
    new.lines <- c(new.lines, lk.cor)
  }
  
  return(list(iov=v.iov,d.iov=d.iov,lines=new.lines))
}

addiov0 <- function(var.iov, v.iov, output) {
  # add the outputs with IOV in the list of variables with IOV in section LONGITUDINAL
  for (k in 1:length(output)) {
    nk <- output[[k]]$name
    ik <- match(nk, var.iov)
    nk <- nk[!is.na(ik)]
    ik <- ik[!is.na(ik)]
    if (length(ik)>0) {
      v.iov <- unique(c(v.iov, nk))
    }
  }
  return(v.iov)
}

addiov <- function(v.iov, output) {
  # add the outputs with IOV in the list of variables with IOV in section LONGITUDINAL
  o.iov <- NULL
  for (k in 1:length(output)) {
    nk <- output[[k]]$name
    ik <- match(nk, v.iov)
    nk <- nk[!is.na(ik)]
    ik <- ik[!is.na(ik)]
    if (length(ik)>0) {
      o.iov <- unique(c(o.iov, nk))
    }
  }
  return(o.iov)
}

outiov <- function(output,v.iov,occ, v.iov0) {
  new.output <- list()
  j <- 0
  for (k in 1:length(output)) {
    nk <- output[[k]]$name
    ik <- match(nk, c(v.iov,v.iov0))
    nk <- nk[!is.na(ik)]
    ik <- ik[!is.na(ik)]
    if (length(ik)>0) {
      output[[k]]$name <- setdiff(output[[k]]$name, nk)
      if (is.data.frame(occ[[1]])) 
        outk <- list(name=nk, time=occ[[1]])
      else
        outk <- list(name=nk, time=occ[[1]]$time)
      
      j <-j+1
      new.output[[j]] <- outk
      nk <- setdiff(nk, v.iov0)
      if (length(nk)>0) {
        j <-j+1
        new.output[[j]] <- list(name=paste0(nk,"0"))
      }
    }
  }
  output <- c(output, new.output)
}

param.iov <- function(p, occ) {
  
  suffix <- "_iov"
  occ <- occ[[1]]
  p2 <- p
  if (is.data.frame(occ)) {
    no <- names(occ)
    occ.name <- setdiff(no,c("id","time"))
    nocc <- length(unique(occ[[occ.name]]))
  } else {
    occ.name <- occ$name
    nocc <- length(occ$time)
    no <- c("id", "time", occ.name)
  }
  v.iov <-  c()
  cat <- list()
  indj <- 0
  for (k in (1:length(p))) {
    pk <- p[[k]]
    if (is.data.frame(pk) && (!is.null(pk$time))) {
      jfk <- which(sapply(pk,is.character)|sapply(pk,is.factor))
      jfk <- jfk[names(jfk)!="id"]
      if (length(jfk)>0) {
        #        pk[,jfk] <- as.factor(pk[,jfk])  #OJO
        for (jf in (1:length(jfk))) {
          indj <- indj+1
          cat[[indj]] <- list(name=names(pk)[jfk[jf]], categories=levels(pk[,jfk[jf]]))
        }
      }
      nk <- names(pk)
      so <- setdiff(nk, no)
      if (length(so)==0)
        so <- occ.name
      n.param <- length(so)
      if (!("id" %in% nk)) 
        pk$id <- 1
      
      N <- length(unique(pk$id))
      io <- intersect(nk, no)
      # if ( (is.data.frame(occ) && (!identical(pk[io],occ[io]))) | (!is.data.frame(occ) && any(pk$time!=rep(occ$time,N))) )  
      #   stop("\n occasions defined in the varlevel field and the parameters are different\n", call.=FALSE)
      if (is.data.frame(occ))
        mo <- merge(occ, pk)
      else 
        mo <- merge(data.frame(occ=1:nocc,time=occ$time),pk)
      
      dk <- vector(length=n.param)
      for (j in (1:n.param)) {
        pkj <- mo[c("id",so[j])]
        dk[j] <- (dim(unique(pkj))[1] == N) 
      }
      for (j in (1:length(dk))){
        if (!dk[j])
          pk[so[j]] <- NULL
      }
      pk$time <- NULL
      pk[occ.name] <- NULL
      if (!("id" %in% nk)) 
        pk$id <- NULL
      if (dim(pk)[2]>1)
        p2[[k]] <- unique(pk)
      else
        p2[[k]] <- NULL
      
      pk.occ <- mo
      pk.occ[so[dk]] <- NULL 
      pk.occ["time"] <- NULL
      if (!identical(occ.name,"occ")) {
        pk.occ$occ <- pk.occ[occ.name]
        pk.occ[occ.name] <- NULL
      }
      pkn <- subset(pk.occ, occ==1)
      io <-  which(names(pkn) %in% so[!dk])
      names(pkn)[io] <- paste0(so[!dk],suffix,1)
      pkn$occ <- NULL
      for (ko in (2:nocc)) {
        pko <- subset(pk.occ, occ==ko)
        names(pko)[io] <- paste0(so[!dk],suffix,ko)
        pko$occ <- NULL
        pkn <- merge(pkn,pko, by=c("id"), all=TRUE)
      }
      for (kf in (1:dim(pkn)[2])) {
        if (is.factor(pkn[,kf]))
          pkn[is.na(pkn[,kf]),kf] <- levels(pkn[,kf])[1]
        else
          pkn[is.na(pkn[,kf]),kf] <- NaN
      }
      if (!("id" %in% nk)) {
        pkn$id <- NULL
        pkn <- as.vector(pkn)
      }
      p2[[length(p2)+1]] <- pkn
      v.iov <- c(v.iov, so[!dk])
    }
  }
  p2 <- p2[sapply(p2,length)>0]
  for (j in seq_len(length(cat))) {
    cj <- grep("[\\+\\-\\*<>]",cat[[j]]$categories)
    if (length(cj)>0)
      cat[[j]]$categories[cj] <- paste0("'",cat[[j]]$categories[cj],"'")
  }
  return(list(param=p2, iov=v.iov, cat=cat))
}