https://github.com/cran/automl
Raw File
Tip revision: ab2d7c8d13ae85f6be55b525f76ffcc2f94052ef authored by Alex Boulangé on 16 January 2020, 10:40:09 UTC
version 1.3.2
Tip revision: ab2d7c8
automl.R
sbamlmodcp <- function(mymodelref, mymodel)
{
 mymodel$error <- mymodelref$error
 mymodel$hpar$layersshape <- mymodelref$hpar$layersshape
 mymodel$hpar$layersacttype <- mymodelref$hpar$layersacttype
 for (l in 1:mymodelref$hpar$nblayers)
 {
  mymodel[[paste("mydl_W", l, sep = '')]] <- mymodelref[[paste("mydl_W", l, sep = '')]]
  mymodel[[paste("mydl_vdW", l, sep = '')]] <- mymodelref[[paste("mydl_vdW", l, sep = '')]]
  mymodel[[paste("mydl_sdW", l, sep = '')]] <- mymodelref[[paste("mydl_sdW", l, sep = '')]]
  mymodel[[paste("mydl_bB", l, sep = '')]] <- mymodelref[[paste("mydl_bB", l, sep = '')]]
  mymodel[[paste("mydl_vdbB", l, sep = '')]] <- mymodelref[[paste("mydl_vdbB", l, sep = '')]]
  mymodel[[paste("mydl_sdbB", l, sep = '')]] <- mymodelref[[paste("mydl_sdbB", l, sep = '')]]
  mymodel[[paste("mydl_j", l, sep = '')]] <- mymodelref[[paste("mydl_j", l, sep = '')]]
  mymodel[[paste("mydl_vdj", l, sep = '')]] <- mymodelref[[paste("mydl_vdj", l, sep = '')]]
  mymodel[[paste("mydl_sdj", l, sep = '')]] <- mymodelref[[paste("mydl_sdj", l, sep = '')]]
  mymodel[[paste("mydl_M", l, sep = '')]] <- mymodelref[[paste("mydl_M", l, sep = '')]]
  mymodel[[paste("mydl_vM", l, sep = '')]] <- mymodelref[[paste("mydl_vM", l, sep = '')]]
  mymodel[[paste("mydl_V", l, sep = '')]] <- mymodelref[[paste("mydl_V", l, sep = '')]]
  mymodel[[paste("mydl_vV", l, sep = '')]] <- mymodelref[[paste("mydl_vV", l, sep = '')]]
 }
 return(mymodel)
}

sbamlmodhparcp <- function(mdlref, myhpartoignore, autopar = NULL, hpar)
{
 valmodimpflagok <- 1
 if (is.null(autopar))
 {
  if (any(c("layersshape", "layersacttype") %in% names(hpar)))
  {
   mylastlog <- ("wrng: layersshape or layersacttype defined (mdlref won't be used)")
   warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
   valmodimpflagok <- 0
  }
  if (valmodimpflagok == 1 & "layersdropoprob" %in% names(hpar))
  {
   if (length(hpar$layersdropoprob) != length(mdlref$hpar$layersdropoprob))
   {
    mylastlog <- ("wrng: layersdropoprob defined with incompatible shape (mdlref won't be used)")
    warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
    valmodimpflagok <- 0
   }
  }
  if (valmodimpflagok == 1 & "modexec" %in% names(hpar))
  {
   if (hpar$modexec == "trainwpso" & mdlref$hpar$modexec == "trainwgrad")
   {
    myhpartoignore = c(myhpartoignore, 'psopartpopsize', 'psonbvar2optim', 'psonumiteration',
                       'psovarvalmin', 'psovarvalmax', 'psovelocitymaxratio',
                       'psoinertiadampratio', 'psokappa', 'psophi1', 'psophi2', 'psoseed')
   } else if (hpar$modexec == "trainwgrad" & mdlref$hpar$modexec == "trainwpso")
   {
    myhpartoignore = c(myhpartoignore, 'learningrate', 'lrdecayrate', 'chkgradevery',
                       'chkgradepsilon', 'beta1', 'beta2')
    if (!"minibatchsize" %in% names(hpar)) {myhpartoignore = c(myhpartoignore, "minibatchsize")}
   }
  }
  if (valmodimpflagok == 1 & all(c('autopar', 'mylspsoparamlvauto') %in% names(hpar)))
  {
   myhpartoignore = c(myhpartoignore, c('useautopar', 'overfitautopar', 'verbose'))
  }
 }
 # forcing hpar with mdlref$hpar in agreement with hpar and myhpartoignore
 if (valmodimpflagok == 1)
 {
  for (i in 1:length(mdlref$hpar))
  {
   if (!names(mdlref$hpar)[i] %in% myhpartoignore &
       !names(mdlref$hpar)[i] %in% names(hpar))
   {
    hpar[[names(mdlref$hpar)[i]]] <- mdlref$hpar[[names(mdlref$hpar)[i]]]
   }
  }
 }
 # autopar validated before but may be changed
 if (!is.null(autopar))
 {
  if (autopar$auto_modexec == FALSE) {hpar$modexec <- mdlref$hpar$modexec}
  if (autopar$auto_minibatchsize == FALSE) {hpar$minibatchsize <- mdlref$hpar$minibatchsize}
  if (autopar$auto_learningrate == FALSE) {hpar$learningrate <- mdlref$hpar$learningrate}
  if (autopar$auto_beta1 == FALSE) {hpar$beta1 <- mdlref$hpar$beta1}
  if (autopar$auto_beta2 == FALSE) {hpar$beta2 <- mdlref$hpar$beta2}
  if (autopar$auto_psopartpopsize == FALSE) {hpar$psopartpopsize <- mdlref$hpar$psopartpopsize}
  if (autopar$auto_lambda == FALSE) {hpar$lambda <- mdlref$hpar$lambda}
  if (autopar$auto_psovelocitymaxratio == FALSE) {hpar$psovelocitymaxratio <- mdlref$hpar$psovelocitymaxratio}
  if (autopar$auto_layers == FALSE)
  {
   if (!"layersshape" %in% names(hpar)) {hpar$layersshape <- mdlref$hpar$layersshape}
   if (!"layersacttype" %in% names(hpar)) {hpar$layersacttype <- mdlref$hpar$layersacttype}
   #if layersdropoprob not in hpar, will be defined
  }
  if (any(c("layersshape", "layersacttype", "layersdropoprob") %in% names(hpar)))
  {
   autopar$auto_layers_min <- autopar$auto_layers_max <- mdlref$hpar$nblayers
  }
 }
 return(list(autopar = autopar, hpar = hpar, valmodimpflagok = valmodimpflagok))
}

sbamlmodpsoparam <- function(mylspsoparam, mylspsopart)
{
  mylspsoparam$phi = mylspsoparam$phi1 + mylspsoparam$phi2
  mylspsoparam$chi = 2 * mylspsoparam$kappa / abs(2 - mylspsoparam$phi - sqrt(mylspsoparam$phi^2 - 4 * mylspsoparam$phi))
  mylspsoparam$w = mylspsoparam$chi;# inertia coef (no damping ratio with constriction coefs)
  mylspsoparam$c1 = mylspsoparam$chi * mylspsoparam$phi1;# personal acceleration coef for cognitive composant
  mylspsoparam$c2 = mylspsoparam$chi * mylspsoparam$phi2;# social acceleration coef for social composant
  mylspsoparam$maxvel = (mylspsoparam$varvalmax - mylspsoparam$varvalmin) * mylspsoparam$velocitymaxratio
  mylspsoparam$minvel = -mylspsoparam$maxvel
  mylspsoparam$activpart = 0

  if (is.null(mylspsoparam$modeinit))
  {
   mylastlog <- ("error: no model trained")
   stop(mylastlog);
  } else {
   if (mylspsoparam$modeinit %in% c('angdlpso', 'autopar'))
   {
    mylspsopart <- list(
     Position = NULL,
     Velocity = 0,
     Cost = NA,
     Best = list(
      Position = NULL,
      Cost = NA,
      idpart = NA
     )
    )
    mylspsopart <- rep(list(mylspsopart), mylspsoparam$partpopsize)

    #pop members initialization
    for (i in 1:mylspsoparam$partpopsize)
    {
     if (mylspsoparam$modeinit == 'angdlpso')
     {
      #random solution
      mydl <- mylspsoparam$angdl$mydl
      mydl <- sbamlmoddlparaminit(mydl, mydl$hpar$layersshape, mydl$hpar$layersacttype,
                                  mylspsoparam$seed + i, mydl$hpar$batchnor_mom)
      for (l in 1:mydl$hpar$nblayers)
      {
       # n = mydl$hpar$layersshape[l + 1]
       # m = mydl$hpar$layersshape[l]
       mylspsopart[[i]]$Position <- c(mylspsopart[[i]]$Position, c(mydl[[paste("mydl_W", l, sep = '')]]))
       mylspsopart[[i]]$Position <- c(mylspsopart[[i]]$Position, c(mydl[[paste("mydl_bB", l, sep = '')]]))
       if (mydl$hpar$batchnor_mom != 0)
       {
        mylspsopart[[i]]$Position <- c(mylspsopart[[i]]$Position, c(mydl[[paste("mydl_j", l, sep = '')]]))
       }
       #to avoid stagnation for bB & j
       myprov <- length(mylspsopart[[i]]$Position[mylspsopart[[i]]$Position == 0])
       set.seed(mylspsoparam$seed + i)
       mylspsopart[[i]]$Position[mylspsopart[[i]]$Position == 0] <- stats::runif(n = myprov, min = 0, max = 0.05)
       myprov <- length(mylspsopart[[i]]$Position[mylspsopart[[i]]$Position == 1])
       set.seed(mylspsoparam$seed + i)
       mylspsopart[[i]]$Position[mylspsopart[[i]]$Position == 1] <- stats::runif(n = myprov, min = 0.95, max = 1)
       rm(myprov)
      }
      mylspsoparam$nbvar2optim <- length(mylspsopart[[i]]$Position)
     } else if (mylspsoparam$modeinit == 'autopar')
     {
      #random solution
      set.seed(mylspsoparam$seed + i)
      mylspsopart[[i]]$Position <- stats::runif(n = mylspsoparam$nbvar2optim,
                                                min = mylspsoparam$varvalmin,
                                                max = mylspsoparam$varvalmax)
     }

     if (i == 1)
     {
      #global best
      mylspsoparam$globalbest = list(
       Position = rep(0, mylspsoparam$nbvar2optim),
       Cost = Inf,
       idpart = NA); #the worst possible cost value
      #logs of best each cost operation on each iteration
      mylspsoparam$globbestcostlog = matrix(data = rep(NA, 2 * mylspsoparam$numiteration),
                                            nrow = mylspsoparam$numiteration, ncol = 2,
                                            byrow = FALSE)
      colnames(mylspsoparam$globbestcostlog) = c('idpart', 'cost')
     }
     #initialize velocity
     mylspsopart[[i]]$Velocity <- rep(0, mylspsoparam$nbvar2optim)
     #evaluation
     mylspsopart[[i]]$Cost <- Inf
     #update personal best
     mylspsopart[[i]]$Best$Position <- mylspsopart[[i]]$Position
     mylspsopart[[i]]$Best$Cost <- mylspsopart[[i]]$Cost
     mylspsopart[[i]]$Best$idpart <- i
     if (mylspsoparam$modeinit == 'angdlpso') {mylspsopart[[i]]$angdl$mydl <- mydl}
    }
   }
   return(list(mylspsoparam = mylspsoparam, mylspsopart = mylspsopart))
  }
}

sbamlmodpsooptkern <- function(mylspsoparam, mylspsoactivpart)
{
  # nb: mylspsoparam$activpart must correspond 2 mylspsoactivpart (4 seed)
  #
  # pso kernel sub for active particle
  set.seed(mylspsoparam$seed + mylspsoparam$activpart)
  # update velocity & position
  mylspsoactivpart$Velocity <- mylspsoparam$w * mylspsoactivpart$Velocity +
    (mylspsoparam$c1 * stats::runif(n = mylspsoparam$nbvar2optim, min = 0, max = 1) * (mylspsoactivpart$Best$Position - mylspsoactivpart$Position)) +
    (mylspsoparam$c2 * stats::runif(n = mylspsoparam$nbvar2optim, min = 0, max = 1) * (mylspsoparam$globalbest$Position - mylspsoactivpart$Position))
  mylspsoactivpart$Position <- mylspsoactivpart$Position + mylspsoactivpart$Velocity

  # apply velocity limits
  mylspsoactivpart$Velocity[mylspsoactivpart$Velocity < mylspsoparam$minvel] <- mylspsoparam$minvel
  mylspsoactivpart$Velocity[mylspsoactivpart$Velocity > mylspsoparam$maxvel] <- mylspsoparam$maxvel

  # apply lower and upper bounds limits
  mylspsoactivpart$Position[mylspsoactivpart$Position < mylspsoparam$varvalmin] <- mylspsoparam$varvalmin
  mylspsoactivpart$Position[mylspsoactivpart$Position > mylspsoparam$varvalmax] <- mylspsoparam$varvalmax
  if (mylspsoparam$modecost %in% c('angdlpso'))
  {
    # cost
    mylspsoactivpart <- sbamlmodpsocost(mylspsoparam = mylspsoparam, mylspsoactivpart = mylspsoactivpart)
    if (mylspsoactivpart$Cost < mylspsoactivpart$Best$Cost)
    {
      mylspsoactivpart$Best$Position <- mylspsoactivpart$Position
      mylspsoactivpart$Best$Cost <- mylspsoactivpart$Cost
      mylspsoactivpart$Best$idpart <- mylspsoparam$activpart
    }
    if (mylspsoactivpart$Cost < mylspsoparam$globalbest$Cost)
    {
      mylspsoparam$globalbest <- mylspsoactivpart$Best
      mylspsoparam$angdl$mydl <- mylspsoactivpart$angdl$mydl
    }
  }
  return(list(mylspsoparam = mylspsoparam, mylspsoactivpart = mylspsoactivpart))
}

sbamlmodpsocost <- function(mylspsoparam, mylspsoactivpart)
{
  if (mylspsoparam$modecost == 'angdlpso')
  {
    mydl <- sbamlpart2mydl(mylspsoactivpart = mylspsoactivpart)
    myprovres <- sbamlmoddlfw(mydl, X = mylspsoparam$angdl$X,
                              modexec = mydl$hpar$modexec,
                              nblayers = mydl$hpar$nblayers,
                              layersacttype = mydl$hpar$layersacttype,
                              layersdropoprob = mydl$hpar$layersdropoprob,
                              seed = mydl$hpar$seed,
                              batchnor_mom = mydl$hpar$batchnor_mom,
                              epsil = mydl$hpar$epsil)
    Yhat <- myprovres[["A"]]; mydl <- myprovres[["mydl"]]; rm(myprovres)
    mycost <- sbamlmoddlcost(mydl, y = mylspsoparam$angdl$Y,
                             yhat = Yhat,
                             costtype = mydl$hpar$costtype,
                             lambda = mydl$hpar$lambda,
                             nblayers = mydl$hpar$nblayers,
                             epsil = mydl$hpar$epsil)
    mylspsoactivpart$Cost <- mycost
    mylspsoactivpart$angdl$mydl <- mydl
    return(mylspsoactivpart)
  }
}

sbamlmoddlcost <- function(mydl, y, yhat, costtype, lambda, nblayers, epsil)
{
  if (costtype == 'crossentropy')
  {
    m = dim(y)[2]
    J <- y * log(yhat + epsil) + (1 - y) * log(1 - yhat + epsil)
    J[J > 0] <- 0;# if yhat + epsil > 1
    J <- (-1 / m) * sum(J)
  } else if (costtype == 'mse')
  {
    m = dim(y)[2]
    J <- (1 / (2 * m)) * sum((y - yhat) ^ 2)
  } else if (costtype == 'mape')
  {
    m = dim(y)[2]
    J <- abs((y - yhat) / y)
    J[is.na(J)] <- 0;#if all to 0
    J[is.infinite(J)] <- 1 / epsil;#if y to 0
    J <- (1 / m) * sum(J)
  } else if (costtype == 'custom')
  {
    mytest <- try(eval(parse(text = mydl$hpar$costcustformul)), TRUE)
    if (grepl('error',class(mytest)[1])) {J = Inf}
  }
  if (lambda != 0)
  {
    m = dim(y)[2]
    l2regul <- 0
    for (l in 1:nblayers)
    {
      W <- mydl[[paste("mydl_W", l, sep = '')]]
      l2regul <- l2regul + (lambda / (2 * m)) * sum(W ^ 2)
    }
    J <- J + l2regul
  }
  return(J)
}

sbamlmoddlcostbk <- function(y, yhat, costtype, epsil)
{
  if (costtype == 'crossentropy')
  {
    dJ <- sbamlmatopebroadcst(sbamlmatopebroadcst(y, (yhat + epsil), 'divid') * (-1),
                              sbamlmatopebroadcst((1 - y), (1 - yhat) + epsil, 'divid'),
                              'add')
  } else if (costtype == 'mse')
  {
    dJ <- sbamlmatopebroadcst(yhat, y  * (-1), 'add')
  } else if (costtype == 'mape')
  {
    tmp <- sbamlmatopebroadcst(y, yhat  * (-1), 'add')
    dJ <- abs(sbamlmatopebroadcst(tmp, y, 'divid'))
    dJ[is.na(dJ)] <- 0;#if all to 0
    dJ[is.infinite(dJ)] <- 1 / epsil;#if y to 0
    dJ <- sbamlmatopebroadcst(dJ, tmp, 'divid')
    dJ[is.na(dJ)] <- 0;#if all to 0
    dJ[is.infinite(dJ)] <- 1 / epsil;#if y - yhat tp 0
    dJ <- dJ * (-1)
  }
  return(dJ)
}

sbamlmoddldropo <- function(mymatA, mymatdD, mydropo)
{
  #inverted dropout
  mymin <- min(mymatA)
  mymax <- max(mymatA)
  mymatA <- sbamlmatopebroadcst(mymatA, mymatdD, 'mult') / (1 - mydropo)
  mymatA[mymatA > mymax] <- mymax
  mymatA[mymatA < mymin] <- mymin
  #why not to avoid result > 1 in cost function ...
  return(mymatA)
}

sbamlmoddlgradchk <- function(mydl, X, Y, nblayers, chkgradepsilon, epsil)
{
  mybigthetasize <- 0
  myvectrefpos <- myvectrefposname <- mygradapprox <- mygrad <- c()
  for (l in 1:nblayers)
  {
    myprov <- dim(mydl[[paste("mydl_W", l, sep = '')]])
    myvectrefpos <- c(myvectrefpos, mybigthetasize + myprov[1] * myprov[2])
    mybigthetasize <- mybigthetasize + myprov[1] * myprov[2]
    myvectrefposname <- c(myvectrefposname, paste('W',l,sep = ''))
    myprov <- dim(mydl[[paste("mydl_bB", l, sep = '')]])
    myvectrefpos <- c(myvectrefpos, mybigthetasize + myprov[1] * myprov[2])
    mybigthetasize <- mybigthetasize + myprov[1] * myprov[2]
    myvectrefposname <- c(myvectrefposname, paste('bB',l,sep = ''))
    if (mydl$hpar$batchnor_mom != 0)
    {
      myprov <- dim(mydl[[paste("mydl_j", l, sep = '')]])
      myvectrefpos <- c(myvectrefpos, mybigthetasize + myprov[1] * myprov[2])
      mybigthetasize <- mybigthetasize + myprov[1] * myprov[2]
      myvectrefposname <- c(myvectrefposname, paste('j',l,sep = ''))
      mygrad <- c(mygrad,
                  as.vector(mydl[[paste("mydl_dW", l, sep = '')]]),
                  as.vector(mydl[[paste("mydl_dbB", l, sep = '')]]),
                  as.vector(mydl[[paste("mydl_dj", l, sep = '')]]))
    } else {
      mygrad <- c(mygrad,
                  as.vector(mydl[[paste("mydl_dW", l, sep = '')]]),
                  as.vector(mydl[[paste("mydl_dbB", l, sep = '')]]))
    }
  }
  for (i in 1:mybigthetasize)
  {
    myrefpos <- 1; myflagcontinue <- 1
    while (myflagcontinue == 1)
    {
      if (i <= myvectrefpos[myrefpos])
      {
        myflagcontinue <- 0
      } else {
        myrefpos <- myrefpos + 1
      }
    }
    mymat <- mydl[[paste("mydl_",myvectrefposname[myrefpos] , sep = '')]]
    if (myrefpos == 1)
    {
      myposinmatrix <- i
    } else {
      myposinmatrix <- i - (myvectrefpos[myrefpos - 1])
    }
    myvalref <- mymat[myposinmatrix]
    mymat[myposinmatrix] <- myvalref + chkgradepsilon
    mydl[[paste("mydl_",myvectrefposname[myrefpos] , sep = '')]] <- mymat
    myprovres <- sbamlmoddlfw(mydl, X,
                              mydl$hpar$modexec,
                              nblayers,
                              layersacttype = mydl$hpar$layersacttype,
                              layersdropoprob = mydl$hpar$layersdropoprob,
                              seed = mydl$hpar$seed,
                              batchnor_mom = mydl$hpar$batchnor_mom, epsil = mydl$hpar$epsil)
    Yhat <- myprovres[["A"]]; mydl <- myprovres[["mydl"]]; rm(myprovres)
    Jplusepsilon <- sbamlmoddlcost(mydl, Y, Yhat,
                                   costtype = mydl$hpar$costtype,
                                   lambda = mydl$hpar$lambda,
                                   nblayers = nblayers,
                                   epsil = epsil)
    mymat[myposinmatrix] <- myvalref - chkgradepsilon
    mydl[[paste("mydl_",myvectrefposname[myrefpos] , sep = '')]] <- mymat
    myprovres <- sbamlmoddlfw(mydl, X,
                              mydl$hpar$modexec,
                              nblayers,
                              layersacttype = mydl$hpar$layersacttype,
                              layersdropoprob = mydl$hpar$layersdropoprob,
                              seed = mydl$hpar$seed,
                              batchnor_mom = mydl$hpar$batchnor_mom, epsil = mydl$hpar$epsil)
    Yhat <- myprovres[["A"]]; mydl <- myprovres[["mydl"]]; rm(myprovres)
    Jminusepsilon = sbamlmoddlcost(mydl, Y, Yhat,
                                   costtype = mydl$hpar$costtype,
                                   lambda = mydl$hpar$lambda,
                                   nblayers = nblayers,
                                   epsil = epsil)
    mygradapprox[i] = (Jplusepsilon - Jminusepsilon) / (2 * chkgradepsilon)
    mymat[myposinmatrix] <- myvalref
    mydl[[paste("mydl_",myvectrefposname[myrefpos] , sep = '')]] <- mymat
  }
  numerator = sbamlllnvectnorm((mygradapprox - mygrad), 2)
  denominator = sbamlllnvectnorm(mygradapprox, 2) + sbamlllnvectnorm(mygrad, 2)
  difference = numerator / denominator
  if (difference > chkgradepsilon)
  {
    cat(paste("Backward propagation to monitor! Difference =", difference, '\n'))
    cat(paste('Gradapprox:',
              paste(utils::head(mygradapprox), collapse = ', '), ' ... ', paste(utils::tail(mygradapprox), collapse = ', '),
              'Grad:',
              paste(utils::head(mygrad), collapse = ', '), ' ... ', paste(utils::tail(mygrad), collapse = ', '), '\n', sep = '\n'))
  } else {
    cat(paste("Backward propagation works fine! Difference =", difference, '\n'))
  }
}

automl_train <- function(Xref, Yref, autopar = list(), hpar = list(), mdlref = NULL)
{
  myautomatablehpar <- c('modexec','minibatchsize','learningrate',
                         'beta1','beta2','psopartpopsize',
                         'lambda','psovelocitymaxratio',
                         'layersshape','layersacttype','layersdropoprob')
  sbamlpart2parlln1 <- function(autopar = list(), hpar = list(), mylspsoparam = list())
  {
   sbamlpart2parlln2 <- function(mylspsoactivpart)
   {
    myactivpartnbr <- mylspsoactivpart$Best$idpart
    mylspsoparam$activpart <- myactivpartnbr
    myprovres <- sbamlmodpsooptkern(mylspsoparam = mylspsoparam, mylspsoactivpart = mylspsoactivpart)
    mylspsoparam <- myprovres[["mylspsoparam"]]
    mylspsoactivpart <- myprovres[["mylspsoactivpart"]]
    rm(myprovres)
    hpar$verbose <- FALSE
    hpar$useautopar <- TRUE
    hpar$seedautopar <- autopar$seed;#for train/test constant sampling
    hpar$seed <- autopar$seed + myactivpartnbr
    if (autopar$auto_modexec == TRUE & !"modexec" %in% names(hpar))
    {
     set.seed(autopar$seed + myactivpartnbr)
     hpar$modexec <- c('trainwgrad', 'trainwpso')[sample(2, 1, replace = TRUE)]
    } else if (autopar$auto_modexec == FALSE & !"modexec" %in% names(hpar))
    {
     hpar$modexec <- 'trainwgrad'
    }
    mydep = 1
    if (autopar$auto_minibatchsize == TRUE & !"minibatchsize" %in% names(hpar))
    {
     if (hpar$modexec != 'trainwpso')
     {
      hpar$minibatchsize <- eval(parse(text =
                                        paste0("2^round(",
                                               sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                               " * (",
                                               autopar$auto_minibatchsize_max,
                                               " - (",
                                               autopar$auto_minibatchsize_min,
                                               ")) + (",
                                               autopar$auto_minibatchsize_min,
                                               "), digits = 0)")
      ))
     }
    }
    mydep = mydep + 1
    if (autopar$auto_learningrate == TRUE & !"learningrate" %in% names(hpar))
    {
     hpar$learningrate <- eval(parse(text =
                                      paste0("10^(",
                                             sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                             " * (",
                                             autopar$auto_learningrate_max,
                                             " - (",
                                             autopar$auto_learningrate_min,
                                             ")) + (",
                                             autopar$auto_learningrate_min,
                                             "))")
     ))
    }
    mydep = mydep + 1
    if (autopar$auto_beta1 == TRUE & !"beta1" %in% names(hpar))
    {
     hpar$beta1 <- eval(parse(text =
                               paste0("1 - 10^(-",
                                      sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                      " - 1)")
     ))
    }
    mydep = mydep + 1
    if (autopar$auto_beta2 == TRUE & !"beta2" %in% names(hpar))
    {
     hpar$beta2 <- eval(parse(text =
                               paste0("1 - 10^(-",
                                      sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                      " - 2)")
     ))
    }
    mydep = mydep + 1
    if (autopar$auto_psopartpopsize == TRUE & !"psopartpopsize" %in% names(hpar))
    {
     hpar$psopartpopsize <- eval(parse(text =
                                        paste0("round(",
                                               sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                               " * (",
                                               autopar$auto_psopartpopsize_max,
                                               " - (",
                                               autopar$auto_psopartpopsize_min,
                                               ")) + (",
                                               autopar$auto_psopartpopsize_min,
                                               "), digits = 0)")
     ))
    }
    mydep = mydep + 1
    if (autopar$auto_lambda == TRUE & !"lambda" %in% names(hpar))
    {
     hpar$lambda <- eval(parse(text =
                                paste0("10^(",
                                       sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                       " * (",
                                       autopar$auto_lambda_max,
                                       " - (",
                                       autopar$auto_lambda_min,
                                       ")) + (",
                                       autopar$auto_lambda_min,
                                       "))")
     ))
    }
    mydep = mydep + 1
    if (autopar$auto_psovelocitymaxratio == TRUE & !"psovelocitymaxratio" %in% names(hpar))
    {
     hpar$psovelocitymaxratio <- eval(parse(text =
                                             paste0(sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                                    " * (",
                                                    autopar$auto_psovelocitymaxratio_max,
                                                    " - (",
                                                    autopar$auto_psovelocitymaxratio_min,
                                                    ")) + (",
                                                    autopar$auto_psovelocitymaxratio_min,
                                                    ")")
     ))
    }
    mydep <- mydep + 1
    if (any(c("layersshape", "layersacttype", "layersdropoprob") %in% names(hpar)))
    {
     if ("layersshape" %in% names(hpar))
     {
      mylayernbr <- length(hpar$layersshape)
     } else if ("layersacttype" %in% names(hpar))
     {
      mylayernbr <- length(hpar$layersacttype)
     } else if ("layersdropoprob" %in% names(hpar))
     {
      mylayernbr <- length(hpar$layersdropoprob)
     }
    } else {
     mylayernbr <- eval(parse(text =
                               paste0("round(",
                                      sbamlprepscalem11201(mylspsoactivpart$Position[mydep]),
                                      " * (",
                                      autopar$auto_layers_max,
                                      " - (",
                                      autopar$auto_layers_min,
                                      ")) + (",
                                      autopar$auto_layers_min,
                                      "), digits = 0)")
     ))
    }
    mydep <- mydep + 1
    if (autopar$auto_layers == TRUE & !"layersshape" %in% names(hpar))
    {
     myformula <- "c("
     for (i in mydep:(mydep + mylayernbr - 1))
     {
      if (i != (mydep + mylayernbr - 1))
      {
       myformula <- c(myformula, eval(parse(text =
                                             paste0("round(",
                                                    sbamlprepscalem11201(mylspsoactivpart$Position[i]),
                                                    " * (",
                                                    autopar$auto_layersnodes_max,
                                                    " - (",
                                                    autopar$auto_layersnodes_min,
                                                    ")) + (",
                                                    autopar$auto_layersnodes_min,
                                                    "), digits = 0)")
       )))
       myformula <- c(myformula, ',')
      } else {
       myformula <- c(myformula, '0)')
      }
     }
     hpar$layersshape <-  eval(parse(text = paste(myformula, collapse = '')))
    }
    mydep <- mydep + autopar$auto_layers_max
    if (autopar$auto_layers == TRUE & !"layersacttype" %in% names(hpar))
    {
     myformula <- "c("
     myhiddenacttype <- c('sigmoid', 'relu', 'reluleaky', 'tanh')
     for (i in mydep:(mydep + mylayernbr - 1))
     {
      if (i != (mydep + mylayernbr - 1))
      {
       myformula <- c(myformula, "'", myhiddenacttype[eval(parse(text =
                                                                  paste0("round(",
                                                                         sbamlprepscalem11201(mylspsoactivpart$Position[i]),
                                                                         " * (",
                                                                         length(myhiddenacttype),
                                                                         " - (",
                                                                         1,
                                                                         ")) + (",
                                                                         1,
                                                                         "), digits = 0)")
       ))], "'")
       myformula <- c(myformula, ',')
      } else {
       myformula <- c(myformula, "'')")
      }
     }
     hpar$layersacttype <-  eval(parse(text = paste(myformula, collapse = '')))
    }
    mydep <- mydep + autopar$auto_layers_max
    if (!"layersdropoprob" %in% names(hpar))
    {
     myformula <- "c("
     for (i in mydep:(mydep + mylayernbr - 1))
     {
      if (i != (mydep + mylayernbr - 1))
      {
       if (autopar$auto_layersdropo == FALSE)
       {
        myformula <- c(myformula, 0)
       } else {
        myformula <- c(myformula, eval(parse(text =
                                              paste0(sbamlprepscalem11201(mylspsoactivpart$Position[i]),
                                                     " * (",
                                                     autopar$auto_layersdropoprob_max,
                                                     " - (",
                                                     autopar$auto_layersdropoprob_min,
                                                     ")) + (",
                                                     autopar$auto_layersdropoprob_min,
                                                     ")")
        )))
       }
       myformula <- c(myformula, ',')
      } else {
       myformula <- c(myformula, '0)')
      }
     }
     hpar$layersdropoprob <-  eval(parse(text = paste(myformula, collapse = '')))
    }
    myprovres <- sbamlvalidhpar(hpar = hpar, myruntype = 'auto')
    hpar <- myprovres[["hpar"]]
    valhparflagok <- myprovres[["tstflagok"]]
    rm(myprovres)
    #
    if (valhparflagok == 1)
    {
     setTimeLimit(cpu = Inf, elapsed = autopar$subtimelimit, transient = FALSE)
     mymodel <- try(automl_train_manual(Xref = Xref, Yref = Yref, hpar = hpar), TRUE)
     setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE)
    } else {
     mymodel <- NULL
    }
    if (grepl('error', class(mymodel)[1]) | is.null(mymodel))
    {
     mymodel <- list(error = list(tr = Inf, cv = Inf))
     mylspsoactivpart$Cost <- Inf
    } else
    {
     mylspsoactivpart$Cost <- sbamlmodresult(trerr = mymodel$error$tr,
                                             cverr = mymodel$error$cv,
                                             cvflag = mymodel$hpar$testcvsize != 0 & mymodel$hpar$overfitautopar == FALSE)
     if (mylspsoactivpart$Cost < mylspsoactivpart$Best$Cost)
     {
      mylspsoactivpart$Best$Position <- mylspsoactivpart$Position
      mylspsoactivpart$Best$Cost <- mylspsoactivpart$Cost
      mylspsoactivpart$Best$idpart <- myactivpartnbr
      mylspsoactivpart$Best$model <- mymodel
     }
    }
    return(mylspsoactivpart)
   }
  }
  #
  hparref <- sbamlvalidhpar(hpar = hpar, myruntype = 'rawmanual')[["hpar"]]
  autoparref <- sbamlvalidautopar(autopar = autopar, myruntype = 'rawmanual')[["autopar"]]
  if (!is.null(mdlref))
  {
   myprovres <- sbamltestmodel(mymodel = mdlref, mymodeltype = 'auto', guess1stlayer = TRUE)
   mdlref <- myprovres[["mymodel"]]
   valmodautoflagok <- myprovres[["tstflagok"]]
   rm(myprovres)
   if (valmodautoflagok == 1)
   {
    #initializing autopar with mdlref$autopar if not defined
    for (i in 1:length(names(mdlref$autopar)))
    {
     if (!names(mdlref$autopar)[i] %in% names(autopar))
     {
      autopar[[names(mdlref$autopar)[i]]] <- mdlref$autopar[[names(mdlref$autopar)[i]]]
     }
    }
    #initializing hpar with mdlref$hpar
    autopar <- sbamlvalidautopar(autopar = autopar, myruntype = 'auto')[["autopar"]]
    myprovres <- sbamlmodhparcp(mdlref, myhpartoignore = myautomatablehpar, autopar, hpar)
    autopar <- myprovres[["autopar"]]
    hpar <- myprovres[["hpar"]]
    rm(myprovres)
   }
  } else {valmodautoflagok <- 0}
  #
  Xref <- t(as.matrix(Xref))
  Yref <- t(as.matrix(Yref))
  sbamlmatstest(Xref, Yref)
  Xref <- sbamlmattest(Xref, "Xref")
  Yref <- sbamlmattest(Yref, "Yref")
  #
  if (valmodautoflagok == 0)
  {
   autopar <- sbamlvalidautopar(autopar = autoparref, myruntype = 'manual')[["autopar"]]
  }
  #
  if (autopar$auto_runtype == "2steps")
  {
   myautonbloop <- 2
  } else {
   myautonbloop <- 1
  }
  #
  for (autoloopnbr in 1:myautonbloop)
  {
   if (autopar$auto_runtype %in% c("2steps", "overfitting", "regularization") & autoloopnbr == 1)
   {
    if (autopar$auto_runtype %in% c("2steps", "overfitting"))
    {
     hpar$overfitautopar <- TRUE;#TRUE to overfit (cv but no cv test)
     autopar[["auto_lambda"]] <- FALSE
     autopar[["auto_layersdropo"]] <- FALSE
    } else {
     hpar$overfitautopar <- FALSE;#FALSE to generalize (cv w cv test)
     autopar[["auto_modexec"]] <- FALSE
     autopar[["auto_minibatchsize"]] <- FALSE
     autopar[["auto_learningrate"]] <- FALSE
     autopar[["auto_beta1"]] <- FALSE
     autopar[["auto_beta2"]] <- FALSE
     autopar[["auto_psopartpopsize"]] <- FALSE
     autopar[["auto_psovelocitymaxratio"]] <- FALSE
     autopar[["auto_layers"]] <- FALSE
     #
     autopar[["auto_lambda"]] <- TRUE
     autopar[["auto_layersdropo"]] <- TRUE
    }
    myprovres <- sbamlvalidautopar(autopar = autopar, myruntype = 'auto')
    autopar <- myprovres[["autopar"]]
    if (myprovres[["tstflagok"]] == 0)
    {
     mylastlog <- ("wrng: so mdlref autopar won't be used")
     warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
     autopar <- autoparref
     autopar[["auto_lambda"]] <- FALSE
     autopar[["auto_layersdropo"]] <- FALSE
     autopar <- sbamlvalidautopar(autopar = autopar, myruntype = 'manual')[["autopar"]]
    }
    rm(myprovres)
   } else if (autopar$auto_runtype == "2steps" & autoloopnbr == 2)
   {
    hpar$overfitautopar <- FALSE;#FALSE to generalize (cv w cv test)
    autopar[["auto_modexec"]] <- FALSE
    autopar[["auto_minibatchsize"]] <- FALSE
    autopar[["auto_learningrate"]] <- FALSE
    autopar[["auto_beta1"]] <- FALSE
    autopar[["auto_beta2"]] <- FALSE
    autopar[["auto_psopartpopsize"]] <- FALSE
    autopar[["auto_psovelocitymaxratio"]] <- FALSE
    autopar[["auto_layers"]] <- FALSE
    #
    autopar[["auto_lambda"]] <- TRUE
    autopar[["auto_layersdropo"]] <- TRUE
    #
    myprovres <- sbamltestmodel(mymodel = mdlref, mymodeltype = 'auto', guess1stlayer = TRUE)
    mdlref <- myprovres[["mymodel"]]
    valmodautoflagok <- myprovres[["tstflagok"]]
    rm(myprovres)
    if (valmodautoflagok == 1)
    {
     #initializing autopar with mdlref$autopar if not defined
     for (i in 1:length(names(mdlref$autopar)))
     {
      if (!names(mdlref$autopar)[i] %in% names(autopar))
      {
       autopar[[names(mdlref$autopar)[i]]] <- mdlref$autopar[[names(mdlref$autopar)[i]]]
      }
     }
     #initializing hpar with mdlref$hpar
     autopar <- sbamlvalidautopar(autopar = autopar, myruntype = 'manual')[["autopar"]]
     myprovres <- sbamlmodhparcp(mdlref, myhpartoignore = myautomatablehpar, autopar, hpar)
     autopar <- myprovres[["autopar"]]
     hpar <- myprovres[["hpar"]]
     rm(myprovres)
    }
   }
   #
   mylspsoparam <- list(
   modeinit = autopar$psomodeinit,
   modecost = autopar$psomodecost,
   nbvar2optim = autopar$psonbvar2optim,
   partpopsize = autopar$psopartpopsize,
   numiteration = autopar$numiterations,
   varvalmin = -1, varvalmax = 1,
   velocitymaxratio = autopar$psovelocitymaxratio,
   inertiadampratio = autopar$psoinertiadampratio,
   kappa = autopar$psokappa,
   phi1 = autopar$psophi1,
   phi2 = autopar$psophi2,
   seed = autopar$seed)
   myprovres <- sbamlmodpsoparam(mylspsoparam = mylspsoparam, mylspsopart = NULL)
   mylspsoparam <- myprovres[["mylspsoparam"]]
   mylspsopart <- myprovres[["mylspsopart"]]
   rm(myprovres)
   #
   mymc <- sbamlparllmc(autopar$nbcores)
   sbamlpart2parll <- sbamlpart2parlln1(autopar = autopar, hpar = hpar, mylspsoparam = mylspsoparam)
   #
   for (iternbr in 1:autopar$numiterations)
   {
    if (mymc != 1)
    {
     mylsres <- parallel::mclapply(X = mylspsopart, FUN = sbamlpart2parll,
                                   mc.preschedule = FALSE, mc.set.seed = FALSE,
                                   mc.silent = FALSE, mc.cores = getOption("mc.cores", mymc),
                                   mc.cleanup = TRUE, mc.allow.recursive = FALSE)
    } else {
     mylsres <- lapply(X = mylspsopart, FUN = sbamlpart2parll)
    }
    mylspsopart <- mylsres
    for (i in 1:autopar$psopartpopsize)
    {
     myflagok <- 1
     if (class(mylspsopart[[i]]) != "list")
     {
      myflagok <- 0
     } else
     {
      if (any(!c('Cost', 'Best') %in% names(mylspsopart[[i]])))
      {
       myflagok <- 0
      } else
      {
       if (any(!c('Cost', 'model', 'Position') %in% names(mylspsopart[[i]]$Best)))
       {
        myflagok <- 0
       } else
       {
        if (any(!c('error', 'hpar') %in% names(mylspsopart[[i]]$Best$model)))
        {
         myflagok <- 0
        } else
        {
         if (mylspsopart[[i]]$Best$model$error$tr == Inf)
         {
          myflagok <- 0
         }
        }
       }
      }
     }
     if (iternbr == 1 & i == 1 & autopar$verbose == TRUE)
     {
      if (autopar$auto_runtype == "2steps")
      {
       cat(paste('STEP: ', autoloopnbr,' (',ifelse(autoloopnbr == 1, 'overfitting', 'regularization'),')\n', sep = ''))
      } else if (!autopar$auto_runtype %in% c("normal", "2steps"))
      {
       cat(paste('PRESET: (',ifelse(autopar$auto_runtype == 'overfitting', 'overfitting', 'regularization'),')\n', sep = ''))
      }
      if (myflagok == 1) {cat(paste('(cost: ', mylspsopart[[i]]$Best$model$hpar$costtype,')\n', sep = ''))}
     }
     mylastlog <- paste("iteration", iternbr,
                        "particle", i, sep = " ")
     if (myflagok == 1)
     {
      if (is.na(mylspsopart[[i]]$Best$model$error$cv))
      {
       mylastlog <- paste(mylastlog, "weighted err:", round(mylspsopart[[i]]$Best$Cost, digits = 5), sep = " ")
      } else
      {
       mylastlog <- paste(mylastlog, "weighted err:", round(mylspsopart[[i]]$Best$Cost, digits = 5),
                          "(train:", round(mylspsopart[[i]]$Best$model$error$tr, digits = 5),
                          "cvalid:", round(mylspsopart[[i]]$Best$model$error$cv, digits = 5),
                          ")", sep = " ")
      }
      if (mylspsopart[[i]]$Best$Cost < mylspsoparam$globalbest$Cost)
      {
       mylspsoparam$globalbest <- mylspsopart[[i]]$Best
       mylastlog <- paste(mylastlog, "BEST MODEL KEPT", sep = " ")
      }
     } else
     {
      mylastlog <- paste(mylastlog, "no exploitable results or timeout", sep = " ")
     }
     if (autopar$verbose == TRUE) {cat(paste0(mylastlog, "\n"))}
    }
    mylspsoparam$globbestcostlog[iternbr, 1] <- mylspsoparam$globalbest$idpart
    mylspsoparam$globbestcostlog[iternbr, 2] <- mylspsoparam$globalbest$Cost
   }
   mymodel <- mylspsoparam$globalbest$model
   mylspsoparam$globalbest$model <- NULL
   mymodel$mylspsoparamlvauto <- mylspsoparam
   mymodel$autopar <- autopar
   myprovres <- sbamltestmodel(mymodel = mymodel, mymodeltype = 'auto')
   mymodel <- myprovres[["mymodel"]]
   rm(myprovres)
   if (autopar$auto_runtype == "2steps" & autoloopnbr == 1)
   {
    hpar <- hparref; autopar <- autoparref
    mdlref <- mymodel
   } else {
    return(mymodel)
   }
  }
}

automl_train_manual <- function(Xref, Yref, hpar = list(), mdlref = NULL)
{
  hpar <- sbamlvalidhpar(hpar = hpar, myruntype = 'rawmanual')[["hpar"]]
  if (!is.null(mdlref))
  {
   myprovres <- sbamltestmodel(mymodel = mdlref, mymodeltype = 'manual', guess1stlayer = TRUE)
   mdlref <- myprovres[["mymodel"]]
   valmodimpflagok <- myprovres[["tstflagok"]]
   rm(myprovres)
   if (valmodimpflagok == 1)
   {
    myprovres <- sbamlmodhparcp(mdlref, myhpartoignore = NULL, autopar = NULL, hpar)
    hpar <- myprovres[["hpar"]]
    valmodimpflagok <- myprovres[["valmodimpflagok"]]
    rm(myprovres)
    if ('autopar' %in% names(mdlref))
    {
     hpar$verbose <- TRUE
     hpar$useautopar <- FALSE
    }
   }
  } else {valmodimpflagok <- 0}
  #
  hpar <- sbamlvalidhpar(hpar = hpar, myruntype = 'manual')[["hpar"]]
  if (hpar$useautopar == FALSE)
  {
    Xref <- t(as.matrix(Xref))
    Yref <- t(as.matrix(Yref))
    sbamlmatstest(Xref, Yref)
    Xref <- sbamlmattest(Xref, "Xref")
    Yref <- sbamlmattest(Yref, "Yref")
  }
  mydl <- list()
  mydl$error$cv <- mydl$error$tr <- Inf
  if (valmodimpflagok == 1)
  {
   mydl <- sbamlmodcp(mdlref, mydl)
  }
  mydl[['hpar']] <- hpar
  mydl$hpar$layersshape <- c(dim(Xref)[1], mydl$hpar$layersshape)
  mydl$hpar$layersshape[length(mydl$hpar$layersshape)] <- dim(Yref)[1]
  mydl$hpar$nblayers <- length(mydl$hpar$layersshape) - 1
  if (mydl$hpar$layersacttype[mydl$hpar$nblayers] == '' | mydl$hpar$modexec == 'trainwgrad')
  {
    if (any(!Yref %in% c(0, 1)))
    {
      mydl$hpar$layersacttype[mydl$hpar$nblayers] <- 'linear'
    } else {
      mydl$hpar$layersacttype[mydl$hpar$nblayers] <- 'sigmoid'
    }
  }
  if (mydl$hpar$costcustformul != '' & mydl$hpar$modexec == 'trainwpso')
  {
    mydl$hpar$costtype <- 'custom'
  }
  if (mydl$hpar$costtype == '' | mydl$hpar$modexec == 'trainwgrad')
  {
    if (any(!Yref %in% c(0, 1)))
    {
      if (mydl$hpar$costtype == '') {mydl$hpar$costtype <- 'mse'}
    } else {
      mydl$hpar$costtype <- 'crossentropy'
    }
  }
  mytestokcpt <- 0;#to avoid error with test while not defined
  mytrlastcost <- mycvlastcost <- mydl$hpar$epsil ^ -1;#why not to get a huge number
  if (mydl$hpar$testcvsize != 0)
  {
    mynbtestsoktostop <- 2;#legacy hyperparam dropped to simplify
    #shuffling handled upstream
    mycvpctg <- mydl$hpar$testcvsize / 100
    mycvgainunder <- mydl$hpar$testgainunder
    mythld <- floor(dim(Xref)[2] * mycvpctg)
    if (mydl$hpar$useautopar == FALSE)
    {
     set.seed(mydl$hpar$seed)
    } else {
     set.seed(mydl$hpar$seedautopar)
    }
    mysample <- sample(x = dim(Xref)[2], size = mythld, replace = FALSE)
    Xcv <- matrix(Xref[,mysample], nrow = dim(Xref)[1], byrow = F)
    Ycv <- matrix(Yref[,mysample], nrow = dim(Yref)[1], byrow = F)
    Xref <- matrix(Xref[,-mysample], nrow = dim(Xref)[1], byrow = F)
    Yref <- matrix(Yref[,-mysample], nrow = dim(Yref)[1], byrow = F)
  } else {
    mynbtestsoktostop <- 1;#legacy hyperparam dropped to simplify
    mycvpctg <- mycvgainunder <- 0
  }
  if (mydl$hpar$minibatchsize != 0 & dim(Xref)[2] > mydl$hpar$minibatchsize)
  {
    nbbatch <- ceiling(dim(Xref)[2] / mydl$hpar$minibatchsize)
  } else {
    mydl$hpar$minibatchsize <- dim(Xref)[2]
    nbbatch <- 1
  }
  if (mydl$hpar$modexec == 'trainwgrad')
  {
    if (valmodimpflagok == 0)
    {
     mydl <- sbamlmoddlparaminit(mydl, mydl$hpar$layersshape, mydl$hpar$layersacttype, mydl$hpar$seed, mydl$hpar$batchnor_mom)
    }
  } else if (mydl$hpar$modexec == 'trainwpso')
  {
    mylspsoparam <- list(
      modeinit = mydl$hpar$psomodeinit,
      modecost = mydl$hpar$psomodecost,
      partpopsize = mydl$hpar$psopartpopsize,
      nbvar2optim = NULL, numiteration = mydl$hpar$numiterations,
      varvalmin = mydl$hpar$psovarvalmin, varvalmax = mydl$hpar$psovarvalmax,
      velocitymaxratio = mydl$hpar$psovelocitymaxratio,
      inertiadampratio = mydl$hpar$psoinertiadampratio,
      kappa = mydl$hpar$psokappa, phi1 = mydl$hpar$psophi1, phi2 = mydl$hpar$psophi2,
      seed = mydl$hpar$seed)
    mylspsoparam$angdl$mydl <- mydl
    myprovres <- sbamlmodpsoparam(mylspsoparam = mylspsoparam, mylspsopart = NULL)
    mylspsoparam <- myprovres[["mylspsoparam"]]
    mylspsopart <- myprovres[["mylspsopart"]]
    rm(myprovres)
    if (valmodimpflagok == 1 & "mylspsoparam" %in% names(mdlref))
    {
     mylspsoparam$globalbest <- mdlref$mylspsoparam$globalbest
     mylspsoparam$globalbest$idpart <- 1
     mylspsopart[[1]]$Position <- mylspsopart[[1]]$Best$Position <- mdlref$mylspsoparam$globalbest$Position
     mylspsopart[[1]]$Cost <- mylspsopart[[1]]$Best$Cost <- mdlref$mylspsoparam$globalbest$Cost
    }
  }

  myflagcontinue <- 1
  t <- 1
  if (mydl$hpar$verbose == TRUE)
  {
    cat(paste('(cost: ', mydl$hpar$costtype,')\n', sep = ''))
  }
  for (epochnum in 1:mydl$hpar$numiterations)
  {
    minibatchposstart <- 1
    for (batchnum in 1:nbbatch)
    {
      #ds shuffled upstream ;-)
      minibatchposend <- batchnum * mydl$hpar$minibatchsize
      if (minibatchposend > dim(Xref)[2]) {minibatchposend <- dim(Xref)[2]}
      if (minibatchposstart > dim(Xref)[2]) {minibatchposstart <- dim(Xref)[2]}
      if (nbbatch != 1 | (epochnum == 1 & nbbatch == 1))
      {
        X <- matrix(Xref[,minibatchposstart:minibatchposend], nrow = dim(Xref)[1], byrow = F)
        mydl[["mydl_A0"]] <- X
        Y <- matrix(Yref[,minibatchposstart:minibatchposend], nrow = dim(Yref)[1], byrow = F)
        if (mydl$hpar$modexec == 'trainwpso')
        {
          mylspsoparam$angdl$X <- X
          mylspsoparam$angdl$Y <- Y
        }
      }
      if (mydl$hpar$modexec == 'trainwpso')
      {
        for (i in 1:mylspsoparam$partpopsize)
        {
          mylspsoparam$activpart <- i
          myprovres <- sbamlmodpsooptkern(mylspsoparam = mylspsoparam, mylspsoactivpart = mylspsopart[[i]])
          mylspsoparam <- myprovres[["mylspsoparam"]]
          mylspsopart[[i]] <- myprovres[["mylspsoactivpart"]]
          rm(myprovres)
        }
        mylspsoparam$globbestcostlog[epochnum, 1] <- mylspsoparam$globalbest$idpart
        mylspsoparam$globbestcostlog[epochnum, 2] <- mylspsoparam$globalbest$Cost
        mydl <- mylspsoparam$angdl$mydl;#to set best angdlpso param
      }
      myprovres <- sbamlmoddlfw(mydl, X, mydl$hpar$modexec, mydl$hpar$nblayers, mydl$hpar$layersacttype,
                                mydl$hpar$layersdropoprob, mydl$hpar$seed, mydl$hpar$batchnor_mom,
                                mydl$hpar$epsil, epochnum, batchnum)
      Yhat <- myprovres[["A"]]; mydl <- myprovres[["mydl"]]; rm(myprovres)
      if (mydl$hpar$printcostevery != 0)
      {
        if ((epochnum %% mydl$hpar$printcostevery == 0 | epochnum == mydl$hpar$numiterations) & batchnum %% nbbatch == 0)
        {
          mylastlog <- " "; mytestokcpt <- 0
          mytrcost <- sbamlmoddlcost(mydl, Y, Yhat, mydl$hpar$costtype,
                                     mydl$hpar$lambda, mydl$hpar$nblayers,
                                     mydl$hpar$epsil)
          mydl$error$tr <- mytrcost
          if (mydl$hpar$verbose == TRUE) {cat(paste('cost epoch',epochnum , ': ', mytrcost, sep = ''))}
          if (abs(mytrlastcost - mytrcost) < mydl$hpar$testgainunder)
          {
            mylastlog <- paste(mylastlog, "[test trgainunder OK]", sep = " ")
            mytestokcpt <- mytestokcpt + 1
          }
          mytrlastcost <- mytrcost
          if (mydl$hpar$testcvsize != 0 & mydl$hpar$overfitautopar == FALSE)
          {
            myprovres <- sbamlmoddlfw(mydl, Xcv, 'predict', mydl$hpar$nblayers, mydl$hpar$layersacttype,
                                      mydl$hpar$layersdropoprob, mydl$hpar$seed, mydl$hpar$batchnor_mom,
                                      mydl$hpar$epsil)
            Ycvhat <- myprovres[["A"]]; mydl <- myprovres[["mydl"]]; rm(myprovres)
            mycvcost <- sbamlmoddlcost(mydl, Ycv, Ycvhat, mydl$hpar$costtype, mydl$hpar$lambda,
                                       mydl$hpar$nblayers, mydl$hpar$epsil)
            mydl$error$cv <- mycvcost
            if (mydl$hpar$verbose == TRUE) {cat(paste(' (cv cost: ', mycvcost, ')', sep = ''))}
            if (abs(mycvlastcost - mycvcost) < mycvgainunder)
            {
              mylastlog <- paste(mylastlog, "[test cvgainunder OK]", sep = " ")
              mytestokcpt <- mytestokcpt + 1
            }
            mycvlastcost <- mycvcost
          } else {
            mydl$error$cv <- NA
          }
          if (mydl$hpar$verbose == TRUE)
          {
            cat(paste(' (LR: ', mydl$hpar$learningrate, ')', '\n', sep = ' '))
            if (mylastlog != ' ') {cat(paste(mylastlog), '\n', sep = '')}
          }
          if (mytestokcpt >= mynbtestsoktostop)
          {
            cat(paste0('[', mytestokcpt, ' / ', mynbtestsoktostop, ' cond. OK to exit]\n'))
            myflagcontinue <- 0
          }
        }
      }
      if (mydl$hpar$modexec == 'trainwgrad' & !(epochnum == mydl$hpar$numiterations & batchnum == nbbatch))
      {
        mydl <- sbamlmoddlbk(mydl, Y, Yhat, mydl$hpar$costtype, mydl$hpar$nblayers,
                             mydl$hpar$layersacttype, mydl$hpar$lambda, mydl$hpar$layersdropoprob,
                             mydl$hpar$batchnor_mom, mydl$hpar$epsil, epochnum, batchnum)
        if (mydl$hpar$chkgradevery != 0)
        {
          if (epochnum %% mydl$hpar$chkgradevery == 0 & batchnum %% nbbatch == 0)
          {
            sbamlmoddlgradchk(mydl, X, Y, mydl$hpar$nblayers, mydl$hpar$chkgradepsilon, mydl$hpar$epsil)
          }
        }
        mydl <- sbamlmoddlparamupdt(mydl, mydl$hpar$nblayers, mydl$hpar$learningrate, mydl$hpar$beta1,
                                    mydl$hpar$beta2, t, mydl$hpar$epsil, mydl$hpar$batchnor_mom)
      }
      t <- t + 1
      minibatchposstart <- minibatchposend + 1
    }
    if (myflagcontinue == 0)
    {
      break
    }
    if (mydl$hpar$lrdecayrate != 0)
    {
      mydl$hpar$learningrate <- mydl$hpar$learningrate / (1 + mydl$hpar$lrdecayrate * epochnum)
    }
  }
  if (mydl$hpar$modexec == 'trainwpso')
  {
    mylspsoparam$angdl <- NULL
    mydl$mylspsoparam <- mylspsoparam
  }
  if (mydl$hpar$verbose == TRUE)
  {
    cat(paste('   dim X', ': [', paste(dim(Xref), collapse = ','), ']\n', sep = ''))
    for (l in 1:mydl$hpar$nblayers)
    {
      W <- mydl[[paste("mydl_W", l, sep = '')]]
      bB <- mydl[[paste("mydl_bB", l, sep = '')]]
      cat(paste('   dim W', l, ': [', paste(dim(W), collapse = ','),
                '] (min|max: ',min(W),', ',max(W),
                ')\n   dim bB', l, ': [',  paste(dim(bB), collapse = ','),
                '] (min|max: ',min(bB),', ',max(bB),
                ')\n', sep = ''))
      if (mydl$hpar$batchnor_mom != 0)
      {
        j <- mydl[[paste("mydl_j", l, sep = '')]]
        cat(paste('   dim j', l, ': [', paste(dim(j), collapse = ','),
                  '] (min|max: ',min(j),', ',max(j),
                  ')\n', sep = ''))
      }
    }
    cat(paste('   dim Y', ': [', paste(dim(Yref), collapse = ','), ']\n', sep = ''))
  }
  myprovres <- sbamltestmodel(mymodel = mydl, mymodeltype = 'manual', guess1stlayer = FALSE)
  mydl <- myprovres[["mymodel"]]
  valmodflagok <- myprovres[["tstflagok"]]
  rm(myprovres)
  if (valmodflagok == 0 & mydl$hpar$useautopar == TRUE)
  {
   mylastlog <- ("error: model training error")
   stop(mylastlog);#to return error to automl_train
  }
  for (l in 0:mydl$hpar$nblayers)
  {
   # lightening model
   try(mydl[[paste0("mydl_Z",l)]] <- NULL)
   try(mydl[[paste0("mydl_A",l)]] <- NULL)
   try(mydl[[paste0("mydl_Zn",l)]] <- NULL)
   try(mydl[[paste0("mydl_Zt",l)]] <- NULL)
  }
  return(mydl)
}

automl_predict <- function(model, X, layoutputnum = 0)
{
  Yhat <- sbamlmoddlfw(model, t(X),
                       'predict',
                       ifelse(layoutputnum == 0, model$hpar$nblayer, layoutputnum),
                       model$hpar$layersacttype,
                       c(rep(0, length(model$hpar$layersacttype))),
                       model$hpar$seed,
                       batchnor_mom = model$hpar$batchnor_mom, epsil = model$hpar$epsil)[["A"]]
  if (dim(Yhat)[1] == 1)
  {
    Yhat <- as.vector(Yhat)
  } else {
    Yhat <- as.data.frame(t(Yhat), row.names = NULL, stringsAsFactors = FALSE)
  }
  return(Yhat)
}

sbamlmoddlbk <- function(mydl, Y, Yhat, costtype, nblayers, layersacttype, lambda, layersdropoprob, batchnor_mom, epsil,
                         epochnum = 0, batchnum = 0)
{
  m <- dim(Y)[2]
  for (l in nblayers:1)
  {
    if (l == nblayers)
    {
      dA <- sbamlmoddlcostbk(Y,
                             Yhat,
                             costtype, epsil)
      mydl[[paste("mydl_dA", l, sep = '')]] <- dA
    } else
    {
     dA <- mydl[[paste("mydl_dA", l, sep = '')]]
     if (layersdropoprob[l] != 0 & epochnum != 0 & batchnum != 0)
     {
      D <- mydl[[paste("mydl_D", l, sep = '')]]
      dA <- sbamlmoddldropo(dA, D, layersdropoprob[l])
     }
    }
    if (batchnor_mom == 0)
    {
      dZ <- sbamlmoddlsubbkact(mydl, dA, l, layersacttype[l], batchnor_mom)
    } else
    {
      dZt <- sbamlmoddlsubbkact(mydl, dA, l, layersacttype[l], batchnor_mom)
      # BN
      Z <- mydl[[paste("mydl_Z", l, sep = '')]]
      M <- mydl[[paste("mydl_M", l, sep = '')]]
      V <- mydl[[paste("mydl_V", l, sep = '')]]
      Zn <- mydl[[paste("mydl_Zn", l, sep = '')]]

      dbB <- matrix(apply(dZt, 1, sum), ncol = 1, byrow = FALSE) * (1 / m)
      mydl[[paste("mydl_dbB", l, sep = '')]] <- dbB
      dj <- matrix(apply(sbamlmatopebroadcst(Zn,
                                             dZt, 'mult')
                         , 1, sum), ncol = 1, byrow = FALSE) * (1 / m)
      mydl[[paste("mydl_dj", l, sep = '')]] <- dj
      #dZ
      j <- mydl[[paste("mydl_j", l, sep = '')]]
      Z_M <- sbamlmatopebroadcst(Z, M * (-1), 'add')
      Z_Ms <- Z_M ^ 2
      Ves <- (V + epsil) ^ (1 / 2)
      Vesinv <- Ves ^ (-1)
      dZn <- sbamlmatopebroadcst(dZt, j, 'mult')
      dZ_M1 <- sbamlmatopebroadcst(dZn, Vesinv, 'mult')
      dVesinv <- matrix(apply(sbamlmatopebroadcst(dZn, Z_M, 'mult'), 1, sum),
                        ncol = 1, byrow = FALSE);# * (1 / m)
      dVes <- sbamlmatopebroadcst(dVesinv, (Ves ^ -2) * (-1), 'mult')
      dV <- sbamlmatopebroadcst(dVes, (Ves ^ -1) * 0.5, 'mult')
      dZ_Ms <- dV * (1 / m)
      dZ_M2 <- sbamlmatopebroadcst(Z_M * 2, dZ_Ms, 'mult')
      dZ_M <- sbamlmatopebroadcst(dZ_M1, dZ_M2, 'add')
      dM <- matrix(apply(dZ_M * (-1), 1, sum), ncol = 1, byrow = FALSE)
      dZ <- sbamlmatopebroadcst(dZ_M, dM * (1 / m), 'add')
    }
    Aprev <- mydl[[paste("mydl_A",(l - 1), sep = '')]]
    W <- mydl[[paste("mydl_W", l, sep = '')]]
    mygrads <- sbamlmoddlsubbklin(mydl, dZ, Aprev, W, l, lambda,
                                  batchnor_mom)
    mydl[[paste("mydl_dW", l, sep = '')]] <- mygrads$dW
    if (batchnor_mom == 0)
    {
      mydl[[paste("mydl_dbB", l, sep = '')]] <- mygrads$dbB
    }
    if (l != 1)
    {
      mydl[[paste("mydl_dA", (l - 1), sep = '')]] <- mygrads$dAprev
    }
  }
  return(mydl)
}

sbamlmoddlfw <- function(mydl, X, modexec, nblayers, layersacttype, layersdropoprob, seed, batchnor_mom, epsil,
                         epochnum = 0, batchnum = 0)
{
  Aprev <- X
  for (l in 1:nblayers)
  {
    W <- mydl[[paste("mydl_W", l, sep = '')]]
    bB <- mydl[[paste("mydl_bB", l, sep = '')]]
    if (batchnor_mom == 0)
    {
      Z <- sbamlmatopebroadcst(sbamlmatopebroadcst(W, Aprev, 'dot'), bB, 'add')
      A <- sbamlmoddlsubfwact(Z, layersacttype[l])
    } else {
      Z <- sbamlmatopebroadcst(W, Aprev, 'dot')
      if (modexec %in% c('trainwgrad', 'trainwpso'))
      {
        m = dim(Z)[2]
        M <- (1 / m) * matrix(apply(Z, 1, sum), nrow = dim(Z)[1], ncol = 1, byrow = FALSE)
        Z_M <- sbamlmatopebroadcst(Z, M * (-1), 'add')
        V <- (1 / m) * matrix(apply(Z_M ^ 2, 1, sum), nrow = dim(Z)[1], ncol = 1, byrow = FALSE)
        Vesinv <- (V + epsil) ^ (-1 / 2)
        Zn <- sbamlmatopebroadcst(Z_M, Vesinv, 'mult')
        mydl[[paste("mydl_M", l, sep = '')]] <- M
        mydl[[paste("mydl_V", l, sep = '')]] <- V
        if (modexec == 'trainwpso')
        {
          vM <- mydl[[paste("mydl_vM", l, sep = '')]]
          mydl[[paste("mydl_vM", l, sep = '')]] <- sbamlexponweigtdavg(M, vM, batchnor_mom, tbiascorrection = 1)
          vV <- mydl[[paste("mydl_vV", l, sep = '')]]
          mydl[[paste("mydl_vV", l, sep = '')]] <- sbamlexponweigtdavg(V, vV, batchnor_mom, tbiascorrection = 1)
        }
      } else {
        M <- mydl[[paste("mydl_vM", l, sep = '')]]
        Zn <- sbamlmatopebroadcst(Z, M * (-1), 'add')
        V <- mydl[[paste("mydl_vV", l, sep = '')]]
        Zn <- sbamlmatopebroadcst(Zn, (V + epsil) ^ (-1 / 2), 'mult')
      }
      j <- mydl[[paste("mydl_j", l, sep = '')]]
      Zt <- sbamlmatopebroadcst(sbamlmatopebroadcst(Zn, j, 'mult'), bB, 'add')
      A <- sbamlmoddlsubfwact(Zt, layersacttype[l])
    }
    if (modexec %in% c('trainwgrad', 'trainwpso'))
    {
      if (layersdropoprob[l] != 0 & epochnum != 0 & batchnum != 0)
      {
        set.seed(ifelse(epochnum + batchnum > .Machine$integer.max,
                        epochnum + batchnum - .Machine$integer.max,
                        epochnum + batchnum))
        D <- matrix(stats::runif(n = dim(A)[1] * dim(A)[2], min = 0, max = 1),
                    nrow = dim(A)[1], ncol = dim(A)[2], byrow = FALSE)
        D <- D > layersdropoprob[l]
        A <- sbamlmoddldropo(A, D, layersdropoprob[l])
      }
      mydl[[paste("mydl_Z", l, sep = '')]] <- Z
      mydl[[paste("mydl_A", l, sep = '')]] <- A
      if (layersdropoprob[l] != 0 & epochnum != 0 & batchnum != 0)
      {
        mydl[[paste("mydl_D", l, sep = '')]] <- D
      }
      if (batchnor_mom != 0)
      {
        mydl[[paste("mydl_Zn", l, sep = '')]] <- Zn
        mydl[[paste("mydl_Zt", l, sep = '')]] <- Zt
      }
    }
    if (l != nblayers) {Aprev <- A}
  }
  return(list(A = A, mydl = mydl))
}

sbamlmatopebroadcst <- function(mat1, mat2, optype = 'dot')
{
  # optype
  #  'add' add matrices
  #  'mult' mutiply matrices element wise
  #  'divide' divide matrices element wise
  #  'dot' mutiply matrices
  #
  if (is.null(dim(mat1)) | is.null(dim(mat2)))
  {
    mylastlog <- ("fctmatopebroadcst mat1 or/n 2 is not a matrix")
    stop(mylastlog)
  } else {
    n1 = dim(mat1)[1]
    m1 = dim(mat1)[2]
    n2 = dim(mat2)[1]
    m2 = dim(mat2)[2]
    mat1[is.na(mat1) | is.infinite(mat1)] <- 0
    mat2[is.na(mat2) | is.infinite(mat2)] <- 0
  }
  if ((optype %in% c('add', 'mult', 'divid') & n1 != n2) |
      (optype %in% c('dot') & m1 != n2))
  {
    mylastlog <- paste("fctmatopebroadcst mat1 n mat2 w wrong shape for", optype, sep = " ")
    stop(mylastlog)
  }
  if (optype %in% c('add', 'mult', 'divid'))
  {
    if (m2 == 1 & m2 != m1)
    {
      #broadcast
      mat2 <- matrix(rep(mat2[,1], m1), ncol = m1, byrow = FALSE)
    }
    if (optype == 'add')
    {
      matres <- mat1 + mat2
    } else if (optype == 'mult')
    {
      matres <- mat1 * mat2
    } else if (optype == 'divid')
    {
      mat2[mat2 == 0] <- 1e-12
      matres <- mat1 / mat2
    }
  } else if (optype == 'dot')
  {
    matres <- mat1 %*% mat2
  }
  return(matres)
}

sbamlmoddlsubbkact <- function(mydl, dA, l, activtype, batchnor_mom)
{
  if (activtype == 'sigmoid')
  {
    A <- mydl[[paste("mydl_A", l, sep = '')]]
    dZ <- sbamlmatopebroadcst(dA, sbamlmodsigmoidbk(A), 'mult')
  } else  if (activtype == 'relu')
  {
    if (batchnor_mom == 0)
    {
      Z <- mydl[[paste("mydl_Z", l, sep = '')]]
    } else {
      Z <- mydl[[paste("mydl_Zt", l, sep = '')]]
    }
    dZ <- sbamlmatopebroadcst(dA, sbamlmodrelubk(Z), 'mult')
  } else if (activtype == 'reluleaky')
  {
    if (batchnor_mom == 0)
    {
      Z <- mydl[[paste("mydl_Z", l, sep = '')]]
    } else {
      Z <- mydl[[paste("mydl_Zt", l, sep = '')]]
    }
    dZ <- sbamlmatopebroadcst(dA, sbamlmodreluleakybk(Z), 'mult')
  } else if (activtype == 'tanh')
  {
    A <- mydl[[paste("mydl_A", l, sep = '')]]
    dZ <- sbamlmatopebroadcst(dA, sbamlmodtanhbk(A), 'mult')
  } else if (activtype == 'linear')
  {
    dZ <- dA
  }
  return(dZ)
}

sbamlmoddlsubbklin <- function(mydl, dZ, Aprev, W, l, lambda, batchnor_mom)
{
  m <- dim(Aprev)[2]
  dW <- sbamlmatopebroadcst(dZ, t(Aprev), 'dot') * (1 / m)
  if (lambda != 0)
  {
    dW <- sbamlmatopebroadcst(dW , W * (lambda / m), 'add')
  }
  if (batchnor_mom == 0)
  {
    dbB <- matrix(apply(dZ, 1, sum), ncol = 1, byrow = FALSE) * (1 / m)
    res <- list(
      'dW' = dW,
      'dbB' = dbB
    )
  } else {
    res <- list(
      'dW' = dW
    )
  }

  if (l != 1)
  {
    dAprev <- sbamlmatopebroadcst(t(W), dZ, 'dot')
    res[['dAprev']] = dAprev
  }
  return(res)
}

sbamlmoddlsubfwact <- function(Z, activtype)
{
  if (activtype == 'sigmoid')
  {
    A <- sbamlmodsigmoid(Z)
  } else  if (activtype == 'relu')
  {
    A <- sbamlmodrelu(Z)
  } else if (activtype == 'reluleaky')
  {
    A <- sbamlmodreluleaky(Z)
  } else if (activtype == 'tanh')
  {
    A <- tanh(Z)
  } else if (activtype == 'linear')
  {
    A <- Z
  } else if (activtype == 'softmax')
  {
    A <- sbamlmodsoftmax(Z)
  }
  return(A)
}

sbamlmoddlparaminit <- function(mydl, layersshape, layersacttype, seed, batchnor_mom)
{
  for (l in 1:(length(layersshape) - 1))
  {
    n = layersshape[l + 1]
    m = layersshape[l]
    set.seed(seed + l)
    mymat <- matrix(stats::rnorm(m * n, mean = 0, sd = 1), nrow = n, ncol = m, byrow = FALSE)
    if (layersacttype[l] %in% c('relu', 'reluleaky'))
    {
      mymat <- mymat * sqrt(2 / m)
    } else if (layersacttype[l] == 'tanh')
    {
      mymat <- mymat * sqrt(1 / m)
    } else
    {
      mymat <- mymat * 0.01
    }

    mydl[[paste("mydl_W", l, sep = '')]] <- mymat
    mymat <- matrix(rep(0, m * n), nrow = n, ncol = m)
    mydl[[paste("mydl_vdW", l, sep = '')]] <- mymat
    mydl[[paste("mydl_sdW", l, sep = '')]] <- mymat
    mymat <- matrix(rep(0, n),nrow = n, ncol = 1)
    mydl[[paste("mydl_bB", l, sep = '')]] <- mymat
    mydl[[paste("mydl_vdbB", l, sep = '')]] <- mymat
    mydl[[paste("mydl_sdbB", l, sep = '')]] <- mymat
    #if (batchnor_mom != 0);#legacy: same architecture 4 all since mdlref
    mymat <- matrix(rep(1, n),nrow = n, ncol = 1)
    mydl[[paste("mydl_j", l, sep = '')]] <- mymat
    mydl[[paste("mydl_vdj", l, sep = '')]] <- mymat
    mydl[[paste("mydl_sdj", l, sep = '')]] <- mymat
    mymat <- matrix(rep(0, n),nrow = n, ncol = 1)
    mydl[[paste("mydl_M", l, sep = '')]] <- mymat
    mydl[[paste("mydl_vM", l, sep = '')]] <- mymat
    mydl[[paste("mydl_V", l, sep = '')]] <- mymat
    mydl[[paste("mydl_vV", l, sep = '')]] <- mymat
  }
  return(mydl)
}

sbamlmoddlparamupdt <- function(mydl, nblayers, dllearngrate, beta1, beta2, t, epsil, batchnor_mom)
{
  myflagok <- 1
  for (l in 1:nblayers)
  {
    W <- mydl[[paste("mydl_W", l, sep = '')]]
    dW <- mydl[[paste("mydl_dW", l, sep = '')]]
    bB <- mydl[[paste("mydl_bB", l, sep = '')]]
    dbB <- mydl[[paste("mydl_dbB", l, sep = '')]]
    if (beta1 != 0)
    {
      vdW <- mydl[[paste("mydl_vdW", l, sep = '')]]
      vdW <- sbamlexponweigtdavg(dW, vdW, beta1, t)
      mydl[[paste("mydl_vdW", l, sep = '')]] <- vdW
      vdbB <- mydl[[paste("mydl_vdbB", l, sep = '')]]
      vdbB <- sbamlexponweigtdavg(dbB, vdbB, beta1, t)
      mydl[[paste("mydl_vdbB", l, sep = '')]] <- vdbB
    }
    if (beta2 != 0)
    {
      sdW <- mydl[[paste("mydl_sdW", l, sep = '')]]
      sdW <- sbamlexponweigtdavg(dW ^ 2, sdW, beta2, t)
      mydl[[paste("mydl_sdW", l, sep = '')]] <- sdW
      sdbB <- mydl[[paste("mydl_sdbB", l , sep = '')]]
      sdbB <- sbamlexponweigtdavg(dbB ^ 2, sdbB, beta2, t)
      mydl[[paste("mydl_sdbB", l, sep = '')]] <- sdbB
    }
    if (beta1 != 0 & beta2 == 0 )
    {
      #gradient with Momentum
      dW <- vdW
      dbB <- vdbB
    } else if (beta1 == 0 & beta2 != 0 )
    {
      #gradient with RMSprop
      dW <- sbamlmatopebroadcst(dW, sqrt(sdW) + epsil, 'divid')
      dbB <- sbamlmatopebroadcst(dbB, sqrt(sdbB) + epsil, 'divid')
    } else if (beta1 != 0 & beta2 != 0 )
    {
      #gradient with adam optimization
      dW <- sbamlmatopebroadcst(vdW, sqrt(sdW) + epsil, 'divid')
      dbB <- sbamlmatopebroadcst(vdbB, sqrt(sdbB) + epsil, 'divid')
    }
    W <- sbamlmatopebroadcst(W, (-dllearngrate * dW), 'add')
    mydl[[paste("mydl_W", l, sep = '')]] <- W
    bB <- sbamlmatopebroadcst(bB, (-dllearngrate * dbB), 'add')
    mydl[[paste("mydl_bB", l, sep = '')]] <- bB
    if (any(is.na(W)) | any(is.na(bB)))
    {
      mylastlog <- "error: NaN produced in W or bB \n"
      myflagok <- 0
    }
    # BN
    if (batchnor_mom != 0)
    {
      j <- mydl[[paste("mydl_j", l, sep = '')]]
      dj <- mydl[[paste("mydl_dj", l, sep = '')]]
      if (beta1 != 0)
      {
        vdj <- mydl[[paste("mydl_vdj", l, sep = '')]]
        vdj <- sbamlexponweigtdavg(dj, vdj, beta1, t)
        mydl[[paste("mydl_vdj", l, sep = '')]] <- vdj
      }
      if (beta2 != 0)
      {
        sdj <- mydl[[paste("mydl_sdj", l, sep = '')]]
        sdj <- sbamlexponweigtdavg(dj ^ 2, sdj, beta2, t)
        mydl[[paste("mydl_sdj", l, sep = '')]] <- sdj
      }
      if (beta1 != 0 & beta2 == 0 )
      {
        #gradient with Momentum
        dj <- vdj
      } else if (beta1 == 0 & beta2 != 0 )
      {
        #gradient with RMSprop
        dj <- sbamlmatopebroadcst(dj, sqrt(sdj) + epsil, 'divid')
      } else if (beta1 != 0 & beta2 != 0 )
      {
        #gradient with adam optimization
        dj <- sbamlmatopebroadcst(vdj, sqrt(sdj) + epsil, 'divid')
      }
      j <- sbamlmatopebroadcst(j, (-dllearngrate * dj), 'add')
      if (any(is.na(j)))
      {
        mylastlog <- "error: NaN produced in j \n"
        myflagok <- 0
      }
      mydl[[paste("mydl_j", l, sep = '')]] <- j

      M <- mydl[[paste("mydl_M", l, sep = '')]]
      vM <- mydl[[paste("mydl_vM", l, sep = '')]]
      mydl[[paste("mydl_vM", l, sep = '')]] <- sbamlexponweigtdavg(M, vM, batchnor_mom, t)
      V <- mydl[[paste("mydl_V", l, sep = '')]]
      vV <- mydl[[paste("mydl_vV", l, sep = '')]]
      mydl[[paste("mydl_vV", l, sep = '')]] <- sbamlexponweigtdavg(V, vV, batchnor_mom, t)
    }
    if (myflagok == 0)
    {
      cat(mylastlog)
      stop(mylastlog, call. = FALSE)
    }
  }
  return(mydl)
}

sbamlexponweigtdavg <- function(valtosmooth, prevval, Beta, tbiascorrection = 1)
{
  if (tbiascorrection != 1)
  {
    if (is.null(dim(valtosmooth)))
    {
      newval <- Beta * prevval + valtosmooth * (1 - Beta)
    } else {
      newval <- sbamlmatopebroadcst(Beta * prevval,
                                    valtosmooth * (1 - Beta),
                                    'add')
    }
  } else {
    newval <- valtosmooth
    #newval <- newval * 1 / (1 - Beta ^ tbiascorrection)
  }
  return(newval)
}

sbamlmodrelu <- function(x)
{
  res = ifelse(x < 0, 0, x)
  return(res)
}

sbamlmodrelubk <- function(x)
{
  res = ifelse(x < 0, 0, 1)
  return(res)
}

sbamlmodreluleaky <- function(x)
{
  res = ifelse(x < 0, 0.01 * x, x)
  return(res)
}

sbamlmodreluleakybk <- function(x)
{
  res = ifelse(x < 0, 0.01, 1)
  return(res)
}

sbamlmodsigmoid <- function(z)
{
  g = (1 + exp(-z)) ^ (-1)
  return(g)
}

sbamlmodsigmoidbk <- function(x)
{
  res = x * (1 - x)
  return(res)
}

sbamlmodsoftmax <- function(z)
{
  g = exp(z)
  gs = matrix(apply(g, 2, sum), ncol = ncol(g), nrow = nrow(g), byrow = TRUE)
  g = sbamlmatopebroadcst(g, gs, 'divid')
  return(g)
}

sbamlmodtanhbk <- function(x)
{
  res = 1 - x^2
  return(res)
}

sbamlllnvectnorm <- function(x, n = 2)
{
  res = (sum(x^n))^(1 / n)
  return(res)
}

sbamlgetintdec <- function(x, part='int', nbedec = 0)
{
  #transform negatives val to positives ones
  x = abs(x)
  nbedec2 = nbedec + 1
  pint = as.integer(floor(x + (1/(10 ^ nbedec2))))
  pdec = as.integer(floor(10 ^ nbedec*((x + (1/(10 ^ nbedec2)) - pint))))
  res <- ifelse(part == 'int', pint,pdec)
  return(res)
}

sbamlmattest <- function(mymat, mymatname)
{
  if (is.numeric(mymat))
  {
    if (any(is.na(mymat)))
    {
      mymat[is.na(mymat)] <- 0
      mylastlog <- paste("wrng: NAs replaced by 0s in", mymatname, sep = " ")
      warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
    }
    if (any(is.infinite(mymat)))
    {
      mymat[is.infinite(mymat)] <- 0
      mylastlog <- paste("wrng: infinite values replaced by 0s in", mymatname, sep = " ")
      warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
    }
  } else {
    mylastlog <- paste("error:", mymatname, "type is not numeric", sep = " ")
    stop(mylastlog)
  }
 return(mymat)
}

sbamlmatstest <- function(Xref, Yref)
{
  #on transposed matrices
  if (dim(Xref)[2] != dim(Yref)[2])
  {
    mylastlog <- ("error: Xref and Yref have different number of rows")
    stop(mylastlog)
  }
}

sbamlpart2mydl <- function(mylspsoactivpart)
{
  mydl <- mylspsoactivpart$angdl$mydl
  myvectrefpos1 <- 1
  for (l in 1:mydl$hpar$nblayers)
  {
    myvectrefposname <- paste("mydl_W", l, sep = '')
    myprov <- dim(mydl[[myvectrefposname]])
    myvectrefpos2 <- c(myvectrefpos1 + myprov[1] * myprov[2] - 1)
    mymat <- matrix(mylspsoactivpart$Position[myvectrefpos1:myvectrefpos2], nrow = myprov[1], ncol = myprov[2], byrow = F)
    mydl[[myvectrefposname]] <- mymat
    myvectrefpos1 <- myvectrefpos2 + 1
    myvectrefposname <- paste("mydl_bB", l, sep = '')
    myprov <- dim(mydl[[myvectrefposname]])
    myvectrefpos2 <- c(myvectrefpos1 + myprov[1] * myprov[2] - 1)
    mymat <- matrix(mylspsoactivpart$Position[myvectrefpos1:myvectrefpos2], nrow = myprov[1], ncol = myprov[2], byrow = F)
    mydl[[myvectrefposname]] <- mymat
    myvectrefpos1 <- myvectrefpos2 + 1
    if (mydl$hpar$batchnor_mom != 0)
    {
      myvectrefposname <- paste("mydl_j", l, sep = '')
      myprov <- dim(mydl[[myvectrefposname]])
      myvectrefpos2 <- c(myvectrefpos1 + myprov[1] * myprov[2] - 1)
      mymat <- matrix(mylspsoactivpart$Position[myvectrefpos1:myvectrefpos2], nrow = myprov[1], ncol = myprov[2], byrow = F)
      mydl[[myvectrefposname]] <- mymat
      myvectrefpos1 <- myvectrefpos2 + 1
    }
  }
  return(mydl)
}

sbamlvalidautopar <- function(autopar, myruntype = 'manual')
{
 #myruntype:
 # = 'manual' produce error on error
 # = 'auto' produce warning on error
 # = 'rawmanual' only raw test produce error on error
 # = 'rawauto' only raw test produce warning on error
 myflagok <- 1
 if (class(autopar) != 'list')
 {
  if (myruntype %in% c('manual', 'rawmanual'))
  {
   mylastlog <- ("error: autopar is not a list")
   stop(mylastlog)
  } else if (myruntype %in% c('auto', 'rawauto')) {
   myflagok <- 0
   mylastlog <- ("wrng: autopar is not a list")
   warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
  }
 }
 if (myflagok == 1 & !myruntype %in% c('rawmanual', 'rawauto'))
 {
  #
  myprov <- names(autopar)
  if (!"seed" %in% myprov) {autopar[["seed"]] <- 4}
  if (!"nbcores" %in% myprov) {autopar[["nbcores"]] <- 1}
  if (!"verbose" %in% myprov) {autopar[["verbose"]] <- TRUE}
  if (!"subtimelimit" %in% myprov) {autopar[["subtimelimit"]] <- 3600}
  if (!"psomodeinit" %in% myprov) {autopar[["psomodeinit"]] <- 'autopar'}
  if (!"psomodecost" %in% myprov) {autopar[["psomodecost"]] <- 'autopar'}
  if (!"psopartpopsize" %in% myprov) {autopar[["psopartpopsize"]] <- 8}
  if (!"numiterations" %in% myprov) {autopar[["numiterations"]] <- 3}
  if (!"psovelocitymaxratio" %in% myprov) {autopar[["psovelocitymaxratio"]] <- 0.2}
  if (!"psoinertiadampratio" %in% myprov) {autopar[["psoinertiadampratio"]] <- 1}
  if (!"psokappa" %in% myprov) {autopar[["psokappa"]] <- 1}
  if (!"psophi1" %in% myprov) {autopar[["psophi1"]] <- 2.05}
  if (!"psophi2" %in% myprov) {autopar[["psophi2"]] <- 2.05}
  if (!"auto_modexec" %in% myprov) {autopar[["auto_modexec"]] <- FALSE}
  if (!"auto_runtype" %in% myprov) {autopar[["auto_runtype"]] <- 'normal'}
  if (!"auto_minibatchsize" %in% myprov) {autopar[["auto_minibatchsize"]] <- TRUE}
  if (!"auto_minibatchsize_min" %in% myprov) {autopar[["auto_minibatchsize_min"]] <- 0}
  if (!"auto_minibatchsize_max" %in% myprov) {autopar[["auto_minibatchsize_max"]] <- 9}
  if (!"auto_learningrate" %in% myprov) {autopar[["auto_learningrate"]] <- TRUE}
  if (!"auto_learningrate_min" %in% myprov) {autopar[["auto_learningrate_min"]] <- -5}
  if (!"auto_learningrate_max" %in% myprov) {autopar[["auto_learningrate_max"]] <- -2}
  if (!"auto_beta1" %in% myprov) {autopar[["auto_beta1"]] <- TRUE}
  if (!"auto_beta2" %in% myprov) {autopar[["auto_beta2"]] <- TRUE}
  if (!"auto_psopartpopsize" %in% myprov) {autopar[["auto_psopartpopsize"]] <- TRUE}
  if (!"auto_psopartpopsize_min" %in% myprov) {autopar[["auto_psopartpopsize_min"]] <- 2}
  if (!"auto_psopartpopsize_max" %in% myprov) {autopar[["auto_psopartpopsize_max"]] <- 50}
  if (!"auto_lambda" %in% myprov) {autopar[["auto_lambda"]] <- FALSE}
  if (!"auto_lambda_min" %in% myprov) {autopar[["auto_lambda_min"]] <- -2}
  if (!"auto_lambda_max" %in% myprov) {autopar[["auto_lambda_max"]] <- 4}
  if (!"auto_psovelocitymaxratio" %in% myprov) {autopar[["auto_psovelocitymaxratio"]] <- TRUE}
  if (!"auto_psovelocitymaxratio_min" %in% myprov) {autopar[["auto_psovelocitymaxratio_min"]] <- 0.01}
  if (!"auto_psovelocitymaxratio_max" %in% myprov) {autopar[["auto_psovelocitymaxratio_max"]] <- 0.5}
  if (!"auto_layers" %in% myprov) {autopar[["auto_layers"]] <- TRUE}
  if (!"auto_layers_min" %in% myprov) {autopar[["auto_layers_min"]] <- 1}
  if (!"auto_layers_max" %in% myprov) {autopar[["auto_layers_max"]] <- 2}
  if (!"auto_layersnodes_min" %in% myprov) {autopar[["auto_layersnodes_min"]] <- 3}
  if (!"auto_layersnodes_max" %in% myprov) {autopar[["auto_layersnodes_max"]] <- 33}
  if (!"auto_layersdropo" %in% myprov) {autopar[["auto_layersdropo"]] <- FALSE}
  if (!"auto_layersdropoprob_min" %in% myprov) {autopar[["auto_layersdropoprob_min"]] <- 0.05}
  if (!"auto_layersdropoprob_max" %in% myprov) {autopar[["auto_layersdropoprob_max"]] <- 0.75}
  rm(myprov)
  #
  myprov <- c(autopar$auto_minibatchsize,
              autopar$auto_learningrate,
              autopar$auto_beta1,
              autopar$auto_beta2,
              autopar$auto_psopartpopsize,
              autopar$auto_lambda,
              autopar$auto_psovelocitymaxratio)
  if (autopar$auto_layers == TRUE | autopar$auto_layersdropo == TRUE)
  {
   myprov <- c(myprov, rep(1, (1 + 3 * autopar$auto_layers_max)));#because layers nb, nodes nbs, act types, dropout
  }
  #100 reservations for positions initialization reproductibility
  if (length(myprov) > 100)
  {
   mylastlog <- ("wrng: positions initialization reproductibility")
   warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
  }
  autopar$psonbvar2optim <- ifelse(length(myprov) > 100, length(myprov), 100);

  if (sum(myprov) == 0 & autopar$numiterations > 1)
  {
   if (myruntype %in% c('manual'))
   {
    mylastlog <- ("error: no auto hpar set to TRUE in autopar")
    stop(mylastlog)
   } else if (myruntype %in% c('auto')) {
    myflagok <- 0
    mylastlog <- ("wrng: no auto hpar set to TRUE in autopar")
    warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
   }
  }
  rm(myprov)
 }
 return(list(autopar = autopar, tstflagok = myflagok))
}

sbamlvalidhpar <- function(hpar, myruntype = 'manual')
{
 #myruntype:
 # = 'manual' produce error on error
 # = 'auto' produce warning on error
 # = 'rawmanual' only raw test produce error on error
 # = 'rawauto' only raw test produce warning on error
 myflagok <- 1
 if (class(hpar) != 'list')
 {
  if (myruntype %in% c('manual', 'rawmanual'))
  {
   mylastlog <- ("error: hpar is not a list")
   stop(mylastlog)
  } else if (myruntype %in% c('auto', 'rawauto')) {
   myflagok <- 0
   mylastlog <- ("wrng: hpar is not a list")
   warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
  }
 }
 if (myflagok == 1 & !myruntype %in% c('rawmanual', 'rawauto'))
 {
  if (!"modexec" %in% names(hpar)) {hpar[["modexec"]] <- 'trainwgrad'}
  if (hpar$modexec == 'trainwgrad')
  {
   hpar$psopartpopsize <- 0
   hpar$psonbvar2optim <- 0
   hpar$psonumiteration <- 0
   hpar$psovarvalmin <- 0
   hpar$psovarvalmax <- 0
   hpar$psovelocitymaxratio <- 0
   hpar$psoinertiadampratio <- 0
   hpar$psokappa <- 0
   hpar$psophi1 <- 0
   hpar$psophi2 <- 0
   hpar$psoseed <- 0
  } else if (hpar$modexec == 'trainwpso')
  {
   if (!"minibatchsize" %in% names(hpar)) {hpar[["minibatchsize"]] <- 0}
   hpar$learningrate <- 0
   hpar$lrdecayrate <- 0
   hpar$chkgradevery <- 0
   hpar$chkgradepsilon <- 0
   hpar$beta1 <- 0
   hpar$beta2 <- 0
  }
  myprov <- names(hpar)
  if (!"useautopar" %in% myprov) {hpar[["useautopar"]] <- FALSE}
  if (!"overfitautopar" %in% myprov) {hpar[["overfitautopar"]] <- FALSE}
  if (!"seed" %in% myprov) {hpar[["seed"]] <- 4}
  if (!"minibatchsize" %in% myprov) {hpar[["minibatchsize"]] <- 2^5}
  if (!"layersshape" %in% myprov) {hpar[["layersshape"]] <- c(10, 0)}
  if (!"layersacttype" %in% myprov) {hpar[["layersacttype"]] <- c('relu', '')}
  if (!"layersdropoprob" %in% myprov) {hpar[["layersdropoprob"]] <- c(0, 0)}
  if (!"costtype" %in% myprov) {hpar[["costtype"]] <- ''}
  if (!"costcustformul" %in% myprov) {hpar[["costcustformul"]] <- ''}
  if (!"printcostevery" %in% myprov) {hpar[["printcostevery"]] <- 10}
  if (!"learningrate" %in% myprov) {hpar[["learningrate"]] <- 0.001}
  if (!"lrdecayrate" %in% myprov) {hpar[["lrdecayrate"]] <- 0}
  if (!"numiterations" %in% myprov) {hpar[["numiterations"]] <- 50}
  if (!"chkgradevery" %in% myprov) {hpar[["chkgradevery"]] <- 0}
  if (!"chkgradepsilon" %in% myprov) {hpar[["chkgradepsilon"]] <- 1e-7}
  if (!"lambda" %in% myprov) {hpar[["lambda"]] <- 0}
  if (!"beta1" %in% myprov) {hpar[["beta1"]] <- 0.9}
  if (!"beta2" %in% myprov) {hpar[["beta2"]] <- 0.999}
  if (!"epsil" %in% myprov) {hpar[["epsil"]] <- 1e-12}
  if (!"batchnor_mom" %in% myprov) {hpar[["batchnor_mom"]] <- 0}
  if (!"testcvsize" %in% myprov) {hpar[["testcvsize"]] <- 10}
  if (!"testgainunder" %in% myprov) {hpar[["testgainunder"]] <- 0.000001}
  if (!"psomodeinit" %in% myprov) {hpar[["psomodeinit"]] <- 'angdlpso'}
  if (!"psomodecost" %in% myprov) {hpar[["psomodecost"]] <- 'angdlpso'}
  if (!"psopartpopsize" %in% myprov) {hpar[["psopartpopsize"]] <- 50}
  if (!"psovarvalmin" %in% myprov) {hpar[["psovarvalmin"]] <- -10}
  if (!"psovarvalmax" %in% myprov) {hpar[["psovarvalmax"]] <- 10}
  if (!"psovelocitymaxratio" %in% myprov) {hpar[["psovelocitymaxratio"]] <- 0.2}
  if (!"psoinertiadampratio" %in% myprov) {hpar[["psoinertiadampratio"]] <- 1}
  if (!"psokappa" %in% myprov) {hpar[["psokappa"]] <- 1}
  if (!"psophi1" %in% myprov) {hpar[["psophi1"]] <- 2.05}
  if (!"psophi2" %in% myprov) {hpar[["psophi2"]] <- 2.05}
  if (!"verbose" %in% myprov) {hpar[["verbose"]] <- TRUE}
  if (length(hpar$layersshape) != length(hpar$layersacttype) |
      length(hpar$layersshape) != length(hpar$layersdropoprob))
  {
   mylastlog <- paste("layersshape, layersacttype and layersdropoprob must have same length (",
                      length(hpar$layersshape), length(hpar$layersacttype), length(hpar$layersdropoprob),
                      ")", sep = " ")
   if (myruntype == 'manual')
   {
    mylastlog <- paste("error: ", mylastlog, sep = " ")
    stop(mylastlog)
   } else {
    myflagok <- 0
    mylastlog <- paste("wrng: ", mylastlog, sep = " ")
    warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
   }
  }
  rm(myprov)
 }
 return(list(hpar = hpar, tstflagok = myflagok))
}

sbamlmodresult <- function(trerr, cverr, cvflag = TRUE)
{
  if (is.na(trerr)) {trerr <- Inf}
  if (is.na(cverr)) {cverr <- Inf}
  if (cvflag == TRUE)
  {
    err  <- abs(trerr - cverr) + ((1.5 * cverr + trerr) / 2.5)
  } else {
    err <- trerr
  }
  if (is.na(err)) {err <- Inf}
  return(err)
}

sbamlparllmc <- function(nbcores)
{
  myprov <- parallel::detectCores(all.tests = FALSE, logical = TRUE)
  mymc <- ifelse(nbcores <= myprov,
                 nbcores,
                 myprov)
  if (gregexpr("dows", Sys.info()["sysname"]) > 0)
  {
    mymc <- 1
  }
  return(mymc)
}

sbamlprepscalem11201 <- function(x)
{
  z <- (x + 1)/2
  return(z)
}

sbamltestmodel <- function(mymodel, mymodeltype = 'manual', guess1stlayer = FALSE)
{
 #myruntype = 'manual' or 'auto' produce only warning on error
 myflagok <- 1
 if (class(mymodel) != 'list')
 {
  mymodel <- list()
  mylastlog <- ("wrng: no exploitable model")
  warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
  myflagok <- 0
 } else
 {
  if (any(!c('error', 'hpar') %in% names(mymodel)))
  {
   mylastlog <- ("wrng: no exploitable model")
   warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
   myflagok <- 0
  } else
  {
   if (myflagok == 1 & any(!c('useautopar',
                              'layersshape') %in% names(mymodel$hpar)))
   {
    mylastlog <- ("wrng: missing hpar parameters in model")
    warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
    myflagok <- 0
   }
   if (myflagok == 1 & guess1stlayer == TRUE)
   {
    mymodel$hpar[["layersshape"]] <- mymodel$hpar$layersshape[2:length(mymodel$hpar$layersshape)]
   }
   if (myflagok == 1 & (is.infinite(mymodel$error$tr) | is.infinite(mymodel$error$cv)))
   {
    mylastlog <- ("wrng: model create infinite error")
    warning(mylastlog, immediate. = FALSE, noBreaks. = TRUE)
    myflagok <- 0
   }
  }
  if (myflagok == 1 & mymodeltype == 'auto' & any(!c('autopar',
                                                     'mylspsoparamlvauto') %in% names(mymodel)))
  {
   myflagok <- 0
   mylastlog <- "wrng: model not trained with automl_train (ignored)"
  }
 }
 if (myflagok == 0)
 {
  mymodel <- NULL
 }
 return(list(mymodel = mymodel, tstflagok = myflagok))
}
back to top