stanfit_one <- function(gdat, dz, nnfits, which.spax,
                        prep_data = prep_data_mod,
                        init_opt = init_opt_mod,
                        init_sampler = init_sampler_mod,
                        stan_model=NULL,
                        stan_file="spm_dust_mod_simpl.stan", stan_filedir="~/spmcode/",
                        iter_opt=5000,
                        jv=1.e-4,
                        iter=1000, warmup=250, thin=1, chains=4,
                        OP=FALSE, ...) {

    require(rstan)
    if (is.null(stan_model)) {
      stan_model <- rstan::stan_model(file=file.path(stan_filedir, stan_file))
    }

    spm_data <- prep_data(gdat, dz, nnfits, which.spax)
    inits <- init_opt(spm_data, nnfits, which.spax, jv)
    spm_opt <- optimizing(stan_model, data=spm_data, init=inits, as_vector=FALSE, verbose=TRUE, iter=iter_opt)

    init_pars <- lapply(X=1:chains, init_sampler, stan_opt=spm_opt$par, jv=jv)

    stanfit <- sampling(stan_model, data=spm_data,
                     chains=chains, iter=iter, warmup=warmup, thin=thin,
                     cores=min(chains, getOption("mc.cores")),
                     init=init_pars, open_progress=OP, ...)

    list(spm_data=spm_data, stanfit=stanfit,
         norm_g=spm_data$norm_g, norm_st=spm_data$norm_st, norm_em=spm_data$norm_em, in_em=spm_data$in_em)
}

stanfit_batch <- function(gdat, dz, nnfits,
                        init_tracked = init_tracked_mod,
                        update_tracked = update_tracked_mod,
                        return_tracked = return_tracked_mod,
                        prep_data = prep_data_mod,
                        init_opt = init_opt_mod,
                        init_sampler = init_sampler_mod,
                        stan_file="spm_dust_mod_simpl.stan", stan_filedir="~/spmcode/",
                        iter_opt=5000,
                        jv=1.e-4,
                        iter=1000, warmup=250, chains=4,
                        OP=FALSE,
                        start=NULL, end=NULL, fpart="bfits.rda", ...) {
    dims <- dim(gdat$flux)
    dz <- dz$dz
    nsim <- (iter-warmup)*chains
    nt <- length(ages)
    nr <- dims[1]
    n_st <- ncol(lib.ssp)-1
    n_em <- length(emlines)
    nl <- length(gdat$lambda)
    smodel <- rstan::stan_model(file.path(stan_filedir, stan_file))
    if (is.null(start) || !file.exists(fpart)) {
      init_tracked(nsim, n_st, n_em, nr)
      start <- 1
    } else {
        load(fpart)
    }
    if (is.null(end)) {
      end <- nr
    }
    for (i in start:end) {
        if (is.na(dz[i]) || is.na(nnfits$Mstar[i])) next
        sfit <- stanfit_one(gdat, dz, nnfits, which.spax=i,
                            prep_data,
                            init_opt,
                            init_sampler,
                            stan_model=smodel,
                            iter_opt=iter_opt, jv=jv,
                            iter = iter, warmup = warmup, chains = chains,
                            OP=OP, ...)
        plot(plotpp(sfit)+ggtitle(paste("fiber =", i)))
        update_tracked(i, sfit, fpart)
        rm(sfit)
    }
    return_tracked()
}

## star formation history, mass growth history, etc.

get_sfh <- function(..., z, fibersinbin=1, density=TRUE, tsf=0.1) {
  ins <- list(...)
  if (is.list(ins[[1]])) {
    ins <- ins[[1]]
    post <- rstan::extract(ins$stanfit)
    b_st <- post$b_st
    norm_st <- ins$norm_st
    if (exists("norm_g", ins)) {
      b_st <- b_st*ins$norm_g
      norm_st <- 1/norm_st
    }
  } else {
    b_st <- ins$b_st
    norm_st <- ins$norm_st
  }
  nsim <- nrow(b_st)
  nt <- length(ages)
  nz <- ncol(b_st)/nt
  T.gyr <- 10^(ages-9)
  isf <- which.min(abs(tsf-T.gyr))
  if (density) {
    binarea <- log10(pi*fibersinbin*cosmo::ascale(z)^2)
  } else {
    binarea <- 0
  }
  b_st <- t(t(b_st)*norm_st)*cosmo::lum.sol(1, z)
  rmass <- t(t(b_st) * mstar)
  sfh_post <- matrix(0, nsim, nt)
  mgh_post <- matrix(0, nsim, nt)
  for (i in 1:nz) {
    sfh_post <- sfh_post + b_st[,((i-1)*nt+1):(i*nt)]
    mgh_post <- mgh_post + rmass[,((i-1)*nt+1):(i*nt)]
  }
  totalmg_post <- cbind(rowSums(mgh_post), rowSums(mgh_post) - t(apply(mgh_post, 1, cumsum)))
  mgh_post <- cbind(rep(1, nsim), 1 - (t(apply(mgh_post, 1, cumsum))/rowSums(mgh_post)))
  sfr <- log10(rowSums(sfh_post[,1:isf])/T.gyr[isf])-9.
  relsfr <- sfr - log10(rowSums(sfh_post)/(cosmo::dcos(Inf)$dT-cosmo::dcos(z)$dT)) + 6
  sigma_sfr <- sfr - binarea
  sigma_mstar <- log10(b_st %*% mstar) - binarea
  ssfr <- sigma_sfr - sigma_mstar
  list(sfh_post=sfh_post, mgh_post=mgh_post, totalmg_post=totalmg_post,
       sigma_mstar=sigma_mstar, sigma_sfr=sigma_sfr, ssfr=ssfr, relsfr=relsfr)
}

batch_sfh <- function(gdat, sfits, tsf=0.1) {
  b_st <- sfits$b_st
  norm_st <- sfits$norm_st
  dims <- dim(b_st)
  nsim <- dims[1]
  nt <- length(ages)
  nz <- dims[2]/nt
  nf <- dims[3]
  if (exists("norm_g", sfits)) {
    norm_g <- sfits$norm_g
    norm_st <- 1/norm_st
  } else {
    norm_g <- rep(1, nf)
  }
  z <- gdat$meta$z
  if (!exists("fibersinbin", gdat)) {
    fibersinbin <- rep(1, nf)
  } else {
    fibersinbin <- gdat$fibersinbin
  }

  sfh_post <- array(NA, dim=c(nsim, nt, nf))
  mgh_post <- array(0, dim=c(nsim, nt+1, nf))
  totalmg_post <- matrix(0, nsim, nt+1)
  sigma_mstar <- matrix(NA, nsim, nf)
  sigma_sfr <- matrix(NA, nsim, nf)
  ssfr <- matrix(NA, nsim, nf)
  relsfr <- matrix(NA, nsim, nf)

  for (i in 1:nf) {
    if (is.na(b_st[1, 1, i])) next
    sfi <- get_sfh(b_st=b_st[,,i]*norm_g[i], norm_st=norm_st[,i], z=z, fibersinbin=fibersinbin[i])
    sfh_post[,,i] <- sfi$sfh_post
    mgh_post[,,i] <- sfi$mgh_post
    totalmg_post <- totalmg_post + sfi$totalmg_post
    sigma_mstar[, i] <- sfi$sigma_mstar
    sigma_sfr[, i] <- sfi$sigma_sfr
    ssfr[, i] <- sfi$ssfr
    relsfr[,i] <- sfi$relsfr
  }
  list(sfh_post=sfh_post, mgh_post=mgh_post, totalmg_post=totalmg_post,
       sigma_mstar=sigma_mstar, sigma_sfr=sigma_sfr, ssfr=ssfr, relsfr=relsfr)
}

## some sorta useful summary measures

get_proxies <- function(...) {
  ins <- list(...)
  if (is.list(ins[[1]])) {
    ins <- ins[[1]]
    post <- rstan::extract(ins$stanfit)
    b_st <- post$b_st
    norm_st <- ins$norm_st
    if (exists("a", post)) {
      b_st <- b_st*ins$norm_g
      norm_st <- 1/norm_st
    }
  } else {
    b_st <- ins$b_st
    norm_st <- ins$norm_st
  }
  b_st <- t(t(b_st)*norm_st)
  nz <- length(Z)
  nt <- length(ages)
  T.gyr <- 10^(ages-9)
  tbar <- log10((b_st %*% rep(T.gyr, nz))/rowSums(b_st)) + 9
  tbar_lum <- log10((b_st %*% (rep(T.gyr, nz) * gri.ssp["r",]))/
                   ((b_st %*% gri.ssp["r",]))) + 9
  g_i <- 2.5*log10(b_st %*% gri.ssp["i",]) - 2.5*log10(b_st %*% gri.ssp["g",])
  data.frame(tbar=tbar, tbar_lum=tbar_lum, g_i=g_i)
}

## emission line fluxes, luminosity density, equivalent width

get_em <- function(..., z, fibersinbin=1, ew_width=15) {
  ins <- list(...)
  if (is.list(ins[[1]])) {
    ins <- ins[[1]]
    post <- rstan::extract(ins$stanfit)
    b_st <- post$b_st
    b_em <- post$b_em
    norm_st <- ins$norm_st
    norm_em <- ins$norm_em
    if (exists("norm_g", ins)) {
      b_st <- b_st*ins$norm_g
      b_em <- b_em*ins$norm_g
      norm_st <- 1/norm_st
    }
 } else {
    b_st <- ins$b_st
    b_em <- ins$b_em
    norm_st <- ins$norm_st
    norm_em <- ins$norm_em
  }
  emlines <- emlines[ins$in.em]
  b_st <- t(t(b_st)*norm_st)
  ne <- ncol(b_em)
  nsim <- nrow(b_em)
  binarea <- log10(pi*fibersinbin*cosmo::ascale(z)^2)
  em.mult <- emlines*log(10)/10000

  flux_em <- matrix(NA, nsim, ne)
  sigma_logl_em <- matrix(NA, nsim, ne)
  ew_em <- matrix(NA, nsim, ne)

  flux_em <- t(t(b_em)*em.mult)*norm_em
  sigma_logl_em <- cosmo::loglum.ergs(flux_em, z) - binarea

  mu_st <- tcrossprod(b_st, as.matrix(lib.ssp[, -1]))
  il_em <- findInterval(emlines, lib.ssp$lambda)
  for (i in 1:ne) {
    intvl <- (il_em[i]-ew_width):(il_em[i]+ew_width)
    fc <- rowMeans(mu_st[, intvl])
    ew_em[, i] <- flux_em[, i]/fc
  }
  colnames(flux_em) <- names(emlines)
  colnames(sigma_logl_em) <- names(emlines)
  colnames(ew_em) <- names(emlines)
  list(flux_em=flux_em, sigma_logl_em=sigma_logl_em, ew_em=ew_em)
}

batch_em <- function(gdat, sfits, ew_width=15) {
  nsim <- dim(sfits$b_em)[1]
  ne <- length(emlines)
  nf <- length(gdat$xpos)
  norm_st <- sfits$norm_st
  if (exists("norm_g", sfits)) {
    norm_g <- sfits$norm_g
    norm_st <- 1/sfits$norm_st
  } else {
    norm_g <- rep(1, nf)
  }

  flux_em <- array(NA, dim=c(nsim, ne, nf))
  sigma_logl_em <- array(NA, dim=c(nsim, ne, nf))
  ew_em <- array(NA, dim=c(nsim, ne, nf))

  for (i in 1:nf) {
    if (is.na(sfits$b_st[1, 1, i])) next
    in.em <- sfits$in_em[!is.na(sfits$in_em[,i]), i]
    if(is.null(dim(norm_st))) {
      nst <- norm_st[i]
    } else {
      nst <- norm_st[,i]
    }
    emi <- get_em(b_em=sfits$b_em[,in.em,i]*norm_g[i], b_st=sfits$b_st[,,i]*norm_g[i],
                  norm_em=sfits$norm_em[i], norm_st=nst,
                  in.em=in.em, z=gdat$meta$z,
                  fibersinbin=gdat$fibersinbin[i], ew_width=ew_width)
    flux_em[,in.em,i] <- emi$flux_em
    sigma_logl_em[,in.em,i] <- emi$sigma_logl_em
    ew_em[,in.em,i] <- emi$ew_em
  }
  dimnames(flux_em)[[2]] <- names(emlines)
  dimnames(sigma_logl_em)[[2]] <- names(emlines)
  dimnames(ew_em)[[2]] <- names(emlines)
  list(flux_em=flux_em, sigma_logl_em=sigma_logl_em, ew_em=ew_em)
}

## bpt class from [N II]/Halpha

batch_bptclass <- function(flux_em, snthresh=3) {
  nb <- dim(flux_em)[3]
  bpt <- as.factor(rep("NO EM", nb))
  levels(bpt) <- c("NO EM", "EL", "SF", "COMP", "LINER", "AGN")
  f_m <- apply(flux_em, c(2, 3), mean)
  f_sd <- apply(flux_em, c(2, 3), sd)
  for (i in 1:nb) {
    if (all(is.na(f_m[, i]))) {
      bpt[i] <- NA
      next
    }
    if(any(f_m[, i]/f_sd[, i] > snthresh, na.rm=TRUE)) bpt[i] <- "EL"
    if (any(is.na(f_m[c("h_beta", "oiii_5007", "h_alpha", "nii_6584"), i]))) next
    if (f_m["h_beta", i]/f_sd["h_beta", i] > snthresh &&
        f_m["oiii_5007", i]/f_sd["oiii_5007", i] > snthresh &&
        f_m["h_alpha", i]/f_sd["h_alpha", i] > snthresh &&
        f_m["nii_6584", i]/f_sd["nii_6584", i] > snthresh) {
      o3hbeta <- log10(f_m["oiii_5007", i]/f_m["h_beta", i])
      n2halpha <- log10(f_m["nii_6584", i]/f_m["h_alpha", i])
      if ((o3hbeta <= 0.61/(n2halpha-0.05)+1.3) &&
         (n2halpha <= 0.05)) {
        bpt[i] <- "SF"
        next
      }
      if ((o3hbeta > 0.61/(n2halpha-0.05)+1.3 || n2halpha > 0.05) &&
          (o3hbeta <= 0.61/(n2halpha-0.47)+1.19)) {
        bpt[i] <- "COMP"
        next
      }
      if ((o3hbeta > 0.61/(n2halpha-0.47)+1.19 || n2halpha > 0.47) &&
          (o3hbeta > 1.05*n2halpha+0.45)) {
        bpt[i] <- "AGN"
      } else {
        bpt[i] <- "LINER"
      }
    }
  }
  bpt
}

## emission line ratios and various "strong line" metallicity calibrations

get_lineratios <- function(flux_em, tauv, delta=0, tauv_mult=1, alaw=calzetti_mod) {
  o3hbeta <- log10(flux_em[,"oiii_5007"]/flux_em[,"h_beta"])
  o1halpha <- log10(flux_em[,"oi_6300"]/flux_em[,"h_alpha"])
  n2halpha <- log10(flux_em[,"nii_6584"]/flux_em[,"h_alpha"])
  s2halpha <- log10((flux_em[,"sii_6717"]+flux_em[,"sii_6730"])/flux_em[,"h_alpha"])

  o2 <- (flux_em[,"oii_3727"]+flux_em[,"oii_3729"])*alaw(3728., -tauv*tauv_mult, delta)
  o3 <- (flux_em[,"oiii_4959"]+flux_em[,"oiii_5007"])*alaw(4980., -tauv*tauv_mult, delta)
  hb <- flux_em[,"h_beta"]*alaw(4863., -tauv*tauv_mult, delta)

  r23 <- log10((o2+o3)/hb)
  o3n2 <- o3hbeta-n2halpha

  ## log(O/H) estimates from Pettini & Pagel 2004, Tremonti et al. 2004, or Dopita et al. 2016

  oh_n2 <- 9.37+2.03*n2halpha+1.26*n2halpha^2+0.32*n2halpha^3
  oh_o3n2 <- 8.73-0.32*o3n2
  oh_r23 <- 9.185-0.313*r23-0.264*r23^2-0.321*r23^3
  oh_n2s2ha <- 8.77+n2halpha-s2halpha+0.264*n2halpha

  data.frame(o3hbeta=o3hbeta, o1halpha=o1halpha, n2halpha=n2halpha, s2halpha=s2halpha,
             r23=r23, o3n2=o3n2,
             oh_n2=oh_n2, oh_o3n2=oh_o3n2, oh_r23=oh_r23, oh_n2s2ha=oh_n2s2ha)
}

sum_batchfits <- function(gdat, nnfits, sfits, drpcat, alaw=calzetti_mod, intr_bd=2.86, clim=0.95) {

    tauv.bd <- function(flux_em, intr_bd, delta=0, alaw) {
      bd <- flux_em[,'h_alpha']/flux_em[,'h_beta']
      bd[!is.finite(bd)] <- NA
      tauv <- log(bd/intr_bd)/(log(alaw(6562.8,1, delta))-log(alaw(4861.3,1, delta)))
      tauv[tauv<0] <- 0
      tauv
    }

    logl.ha.cor <- function(logl.halpha, tauv, delta=0, alaw) {
      att <- alaw(lambda=6562.8, tauv, delta)
      logl.halpha - log10(att)
    }

    nf <- length(gdat$xpos)
    fibersinbin <- rep(1, nf)
    if (exists("bin.fiber", gdat)) {
      if (!exists("fibersinbin", gdat)) {
        bin.fiber <- gdat$bin.fiber
        bin.no <- unique(bin.fiber[!is.na(bin.fiber)])
        for (i in seq_along(bin.no)) {
          fibersinbin[i] <- length(which(bin.fiber == bin.no[i]))
        }
      } else {
        fibersinbin <- gdat$fibersinbin
      }
    }

    nsim <- nrow(sfits$b_st)
    nt <- length(ages)
    fiberarea <- pi*cosmo::ascale(gdat$meta$z)^2
    plateifu <- rep(gdat$meta$plateifu, nf)

    ## projected distance in kpc and relative to effective radius

    d_kpc <- cosmo::ascale(gdat$meta$z)*sqrt(gdat$xpos^2+gdat$ypos^2)
    d_re <- sqrt(gdat$xpos^2+gdat$ypos^2)/
    drpcat$nsa_petro_th50[match(gdat$meta$plateifu,drpcat$plateifu)]

    ## stuff taken from nnfits

    d4000_n <- nnfits$d4000_n
    d4000_n_err <- nnfits$d4000_n_err
    lick_hd_a <- nnfits$lick[,'HdeltaA']
    lick_hd_a_err <- nnfits$lick.err[,'HdeltaA_err']
    mgfe <- sqrt(nnfits$lick[,'Mg_b']*(0.72*nnfits$lick[,'Fe5270']+0.28*nnfits$lick[,'Fe5335']))
    mgfe[is.nan(mgfe)] <- NA

    ## tauv from batch fits

    tauv_m <- colMeans(sfits$tauv)
    tauv_std <- apply(sfits$tauv, 2, sd)

    if (exists("delta", sfits)) {
      delta <- sfits$delta
    } else {
      delta <- matrix(0, nsim, nf)
    }
    delta_m <- colMeans(delta)
    delta_std <- apply(delta, 2, sd)

    if (exists("ll", sfits)) {
      ll_m <- colMeans(sfits$ll)
    } else {
      ll_m <- rep(NA, nf)
    }

    mgh_post <- array(NA, dim=c(nsim, nt+1, nf))
    sfh_post <- array(NA, dim=c(nsim, nt, nf))
    totalmg_post <- matrix(0, nsim, nt+1)

    varnames <- c("sigma_mstar", "sigma_sfr", "ssfr", "relsfr",
                  "tbar", "tbar_lum", "g_i",
                  "tauv_bd", "sigma_logl_ha", "sigma_logl_ha_ctauv", "sigma_logl_ha_ctauv_bd",
                  "eqw_ha", "o3hbeta", "o1halpha", "n2halpha", "s2halpha",
                  "r23", "o3n2", "oh_n2", "oh_o3n2", "oh_r23", "oh_n2s2ha")
    suffixes <- c("m", "std", "lo", "hi")

    for (i in seq_along(varnames)) {
      for (j in seq_along(suffixes)) {
        assign(paste(varnames[i], suffixes[j], sep="_"), numeric(nf))
      }
    }

    sfh_all <- batch_sfh(gdat, sfits)

    for (i in 1:4) {
      assign(paste(varnames[i], suffixes[1], sep="_"), colMeans(sfh_all[[varnames[i]]]))
      assign(paste(varnames[i], suffixes[2], sep="_"), apply(sfh_all[[varnames[i]]], 2, sd))
    }

    em_all <- batch_em(gdat, sfits)
    bpt <- batch_bptclass(em_all$flux_em)

    for (i in 1:nf) {

      ## star formation history, etc.

      quants <- hdiofmcmc(sfh_all$sigma_mstar[,i])
      sigma_mstar_lo[i] <- quants[1]
      sigma_mstar_hi[i] <- quants[2]

      quants <- hdiofmcmc(sfh_all$sigma_sfr[,i])
      sigma_sfr_lo[i] <- quants[1]
      sigma_sfr_hi[i] <- quants[2]

      quants <- hdiofmcmc(sfh_all$ssfr[,i])
      ssfr_lo[i] <- quants[1]
      ssfr_hi[i] <- quants[2]

      quants <- hdiofmcmc(sfh_all$relsfr[,i])
      relsfr_lo[i] <- quants[1]
      relsfr_hi[i] <- quants[2]

      if (is.null(dim(sfits$norm_st))) {
        norm_st <- sfits$norm_st[i]
      } else {
        norm_st <- 1/sfits$norm_st[,i]
      }
      proxi <- get_proxies(b_st=sfits$b_st[,,i], norm_st=norm_st)

      tbar_m[i] <- mean(proxi$tbar)
      tbar_std[i] <- sd(proxi$tbar)
      quants <- hdiofmcmc(proxi$tbar, credmass=clim)
      tbar_lo[i] <- quants[1]
      tbar_hi[i] <- quants[2]

      tbar_lum_m[i] <- mean(proxi$tbar_lum)
      tbar_lum_std[i] <- sd(proxi$tbar_lum)
      quants <- hdiofmcmc(proxi$tbar_lum, credmass=clim)
      tbar_lum_lo[i] <- quants[1]
      tbar_lum_hi[i] <- quants[2]

      g_i_m[i] <- mean(proxi$g_i)
      g_i_std[i] <- sd(proxi$g_i)
      quants <- hdiofmcmc(proxi$g_i, credmass=clim)
      g_i_lo[i] <- quants[1]
      g_i_hi[i] <- quants[2]

      linesi <- get_lineratios(em_all$flux_em[,,i], sfits$tauv[,i], delta[,i], alaw=alaw)

      tauv_bd <- tauv.bd(em_all$flux_em[,,i], intr_bd=intr_bd, delta[,i], alaw=alaw)

      tauv_bd_m[i] <- mean(tauv_bd)
      tauv_bd_std[i] <- sd(tauv_bd)
      quants <- hdiofmcmc(tauv_bd, credmass=clim)
      tauv_bd_lo[i] <- quants[1]
      tauv_bd_hi[i] <- quants[2]

      ## uncorrected Halpha luminosity from stan fits

      sigma_logl_ha_m[i] <- mean(em_all$sigma_logl_em[,"h_alpha", i])
      sigma_logl_ha_std[i] <- sd(em_all$sigma_logl_em[,"h_alpha", i])
      quants <- hdiofmcmc(em_all$sigma_logl_em[,"h_alpha", i], credmass=clim)
      sigma_logl_ha_lo[i] <- quants[1]
      sigma_logl_ha_hi[i] <- quants[2]

      ## correct from stan fit estimate of tauv

      logl_ha_c <- logl.ha.cor(em_all$sigma_logl_em[, "h_alpha", i], sfits$tauv[,i], delta[,i], alaw=alaw)

      sigma_logl_ha_ctauv_m[i] <- mean(logl_ha_c)
      sigma_logl_ha_ctauv_std[i] <- sd(logl_ha_c)
      quants <- hdiofmcmc(logl_ha_c, credmass=clim)
      sigma_logl_ha_ctauv_lo[i] <- quants[1]
      sigma_logl_ha_ctauv_hi[i] <- quants[2]

      ## correct from balmer decrement

      logl_ha_c <- logl.ha.cor(em_all$sigma_logl_em[, "h_alpha", i], tauv_bd, delta[,i], alaw=alaw)

      sigma_logl_ha_ctauv_bd_m[i] <- mean(logl_ha_c)
      sigma_logl_ha_ctauv_bd_std[i] <- sd(logl_ha_c)
      quants <- hdiofmcmc(logl_ha_c, credmass=clim)
      sigma_logl_ha_ctauv_bd_lo[i] <- quants[1]
      sigma_logl_ha_ctauv_bd_hi[i] <- quants[2]

      eqw_ha_m[i] <- mean(em_all$ew_em[,"h_alpha", i])
      eqw_ha_std[i] <- sd(em_all$ew_em[,"h_alpha", i])
      quants <- hdiofmcmc(em_all$ew_em[,"h_alpha", i], credmass=clim)
      eqw_ha_lo[i] <- quants[1]
      eqw_ha_hi[i] <- quants[2]

      ## some emission line ratios

      o3hbeta_m[i] <- mean(linesi$o3hbeta)
      o3hbeta_std[i] <- sd(linesi$o3hbeta)
      quants <- hdiofmcmc(linesi$o3hbeta, credmass=clim)
      o3hbeta_lo[i] <- quants[1]
      o3hbeta_hi[i] <- quants[2]

      o1halpha_m[i] <- mean(linesi$o1halpha)
      o1halpha_std[i] <- sd(linesi$o1halpha)
      quants <- hdiofmcmc(linesi$o1halpha, credmass=clim)
      o1halpha_lo[i] <- quants[1]
      o1halpha_hi[i] <- quants[2]

      n2halpha_m[i] <- mean(linesi$n2halpha)
      n2halpha_std[i] <- sd(linesi$n2halpha)
      quants <- hdiofmcmc(linesi$n2halpha, credmass=clim)
      n2halpha_lo[i] <- quants[1]
      n2halpha_hi[i] <- quants[2]

      s2halpha_m[i] <- mean(linesi$s2halpha)
      s2halpha_std[i] <- sd(linesi$s2halpha)
      quants <- hdiofmcmc(linesi$s2halpha, credmass=clim)
      s2halpha_lo[i] <- quants[1]
      s2halpha_hi[i] <- quants[2]

      r23_m[i] <- mean(linesi$r23)
      r23_std[i] <- sd(linesi$r23)
      quants <- hdiofmcmc(linesi$r23, credmass=clim)
      r23_lo[i] <- quants[1]
      r23_hi[i] <- quants[2]

      o3n2_m[i] <- mean(linesi$o3n2)
      o3n2_std[i] <- sd(linesi$o3n2)
      quants <- hdiofmcmc(linesi$o3n2, credmass=clim)
      o3n2_lo[i] <- quants[1]
      o3n2_hi[i] <- quants[2]

      oh_n2_m[i] <- mean(linesi$oh_n2)
      oh_n2_std[i] <- sd(linesi$oh_n2)
      quants <- hdiofmcmc(linesi$oh_n2, credmass=clim)
      oh_n2_lo[i] <- quants[1]
      oh_n2_hi[i] <- quants[2]

      oh_o3n2_m[i] <- mean(linesi$oh_o3n2)
      oh_o3n2_std[i] <- sd(linesi$oh_o3n2)
      quants <- hdiofmcmc(linesi$oh_o3n2, credmass=clim)
      oh_o3n2_lo[i] <- quants[1]
      oh_o3n2_hi[i] <- quants[2]

      oh_r23_m[i] <- mean(linesi$oh_r23)
      oh_r23_std[i] <- sd(linesi$oh_r23)
      quants <- hdiofmcmc(linesi$oh_r23, credmass=clim)
      oh_r23_lo[i] <- quants[1]
      oh_r23_hi[i] <- quants[2]

      oh_n2s2ha_m[i] <- mean(linesi$oh_n2s2ha)
      oh_n2s2ha_std[i] <- sd(linesi$oh_n2s2ha)
      quants <- hdiofmcmc(linesi$oh_n2s2ha, credmass=clim)
      oh_n2s2ha_lo[i] <- quants[1]
      oh_n2s2ha_hi[i] <- quants[2]
    }

    data.frame(plateifu, d4000_n, d4000_n_err,
               lick_hd_a, lick_hd_a_err, mgfe,
               d_kpc, d_re,
               tauv_m, tauv_std,
               delta_m, delta_std, ll_m=ll_m,
               sigma_mstar_m , sigma_mstar_std , sigma_mstar_lo , sigma_mstar_hi ,
               sigma_sfr_m , sigma_sfr_std , sigma_sfr_lo , sigma_sfr_hi ,
               ssfr_m , ssfr_std , ssfr_lo , ssfr_hi ,
               relsfr_m , relsfr_std , relsfr_lo , relsfr_hi ,
               tbar_m , tbar_std , tbar_lo , tbar_hi ,
               tbar_lum_m , tbar_lum_std , tbar_lum_lo , tbar_lum_hi ,
               g_i_m , g_i_std , g_i_lo , g_i_hi ,
               tauv_bd_m , tauv_bd_std , tauv_bd_lo , tauv_bd_hi ,
               sigma_logl_ha_m , sigma_logl_ha_std , sigma_logl_ha_lo , sigma_logl_ha_hi ,
               sigma_logl_ha_ctauv_m , sigma_logl_ha_ctauv_std , sigma_logl_ha_ctauv_lo , sigma_logl_ha_ctauv_hi ,
               sigma_logl_ha_ctauv_bd_m , sigma_logl_ha_ctauv_bd_std , sigma_logl_ha_ctauv_bd_lo , sigma_logl_ha_ctauv_bd_hi ,
               eqw_ha_m, eqw_ha_std, eqw_ha_lo, eqw_ha_hi,
               o3hbeta_m , o3hbeta_std , o3hbeta_lo , o3hbeta_hi ,
               o1halpha_m , o1halpha_std , o1halpha_lo , o1halpha_hi ,
               n2halpha_m , n2halpha_std , n2halpha_lo , n2halpha_hi ,
               s2halpha_m , s2halpha_std , s2halpha_lo , s2halpha_hi ,
               r23_m , r23_std , r23_lo , r23_hi ,
               o3n2_m , o3n2_std , o3n2_lo , o3n2_hi ,
               oh_n2_m , oh_n2_std , oh_n2_lo , oh_n2_hi ,
               oh_o3n2_m , oh_o3n2_std , oh_o3n2_lo , oh_o3n2_hi ,
               oh_r23_m , oh_r23_std , oh_r23_lo , oh_r23_hi ,
               oh_n2s2ha_m , oh_n2s2ha_std , oh_n2s2ha_lo , oh_n2s2ha_hi ,
               bpt=bpt)
}

## estimated mean mass fraction in broad ages bins

sum_binnedmass <- function(mgh_post, ages, ages.bins = c(0.1, 2.5, 5)) {
  T.gyr <- 10^(ages-9)
  ind.bins <- findInterval(ages.bins, T.gyr)
  dims <- dim(mgh_post)
  nsim <- dims[1]
  nfib <- dims[3]
  nt <- length(ages.bins)+2
  mgh.binned <- mgh_post[, c(1, ind.bins, dims[2]), ]
  mdiff <- mgh.binned[, 1:(nt-1),] - mgh.binned[, 2:nt, ]
  mb_m <- apply(mdiff, c(2, 3), mean)
  mb_sd <- apply(mdiff, c(2, 3), sd)
  df <- data.frame(cbind(t(mb_m), t(mb_sd)))
  df[df==0] <- NA
  T.ind <- c(0, T.gyr[ind.bins], T.gyr[length(T.gyr)])
  nt <- length(T.ind)
  bnames <- paste(formatC(T.ind[1:(nt-1)], format="f", digits=1), " < T < ",
                     formatC(T.ind[2:nt], format="f", digits=1), sep="")
  names(df) <- c(paste(bnames, "_m", sep=""), paste(bnames, "_sd", sep=""))
  df
}

## computes highest density interval from a sample of representative values,
##   estimated as shortest credible interval.
## arguments:
##   samplevec
##     is a vector of representative values from a probability distribution.
##   credmass
##     is a scalar between 0 and 1, indicating the mass within the credible
##     interval that is to be estimated.
## value:
##   hdilim is a vector containing the limits of the hdi

hdiofmcmc <- function(samplevec , credmass=0.95) {
    sortedpts <- sort(samplevec)
    ciidxinc <- floor(credmass * length(sortedpts))
    ncis <- length(sortedpts) - ciidxinc
    ciwidth <- rep(0 , ncis)
    for (i in 1:ncis) {
        ciwidth[i] <- sortedpts[i + ciidxinc] - sortedpts[i]
    }
    hdimin <- sortedpts[which.min(ciwidth)]
    hdimax <- sortedpts[which.min(ciwidth) + ciidxinc]
    hdilim <- c(hdimin , hdimax)
    return(hdilim)
}


#' Calculate mass based on MT3D Model Run
#'
#' This function reads in a btn file, hds file, and ucn file to calculate
#' the total mass (in units of lbs) in the model at each times step.
#'
#' @param BTN This is the name of the .btn file (without the file extension)
#' @param HDS This is the name of the .hds file (without the file extension)
#' @param UCN This is the name of the .ucn file (without the file extension)
#' @export
#' @examples
#' masscalc(BTN = "T04", HDS = "F95", UCN = "T041")
#'
#' # A tibble: 32,325,120 x 7
#'    YEARS   LAY   ROW   COL THICK  CONC  MASS
#'    <dbl> <int> <int> <int> <dbl> <dbl> <dbl>
#' 1      1     1     1     1     0     0     0
#' 2      1     1     1     2     0     0     0
#' 3      1     1     1     3     0     0     0
#' 4      1     1     1     4     0     0     0
#' 5      1     1     1     5     0     0     0
#' 6      1     1     1     6     0     0     0
#' 7      1     1     1     7     0     0     0
#' 8      1     1     1     8     0     0     0
#' 9      1     1     1     9     0     0     0
#' 10     1     1     1    10     0     0     0
#' # ... with 32,325,110 more rows
#'
#' # Determine the total mass in the top layer of model for each timestep:
#' m <- masscalc(BTN = "T04", HDS = "F95", UCN = "T041")
#' m %>% filter(LAY == 1) %>%
#'       group_by(YEARS) %>%
#'       summarise(TOT = sum(MASS))
#' # A tibble: 16 x 2
#'    YEARS      TOT
#'    <dbl>    <dbl>
#' 1      1 4866.663
#' 2      2 4896.831
#' 3      3 4926.615
#' 4      4 4954.909
#' 5      5 4981.363
#' 6      6 5005.803
#' 7      7 5028.133
#' 8      8 5048.347
#' 9      9 5066.414
#' 10    10 5082.366
#' 11    11 5096.217
#' 12    12 5107.996
#' 13    13 5117.772
#' 14    14 5125.564
#' 15    15 5101.810
#' 16   100 1442.831
#'
#' # Note: the total mass is in units of lbs

masscalc <- function(BTN, HDS, UCN){
    b <- readbtn(BTN)
    NLAY  <- b$NLAY
    NCOL  <- b$NCOL
    NROW  <- b$NROW
    NSP   <- b$NPER
    NPRS  <- b$NPRS
    POR   <- b$TRANS$PRSITY
    THICK <- b$TRANS$dZ
    dX    <- b$dX
    dY    <- b$dY
    dZ    <- b$TRANS %>% select(LAY, ROW, COL, dZ)
    TOP   <- b$TOP$TOP
    BOTL1 <- b$TOP$TOP - dZ[dZ$LAY == 1, ]$dZ
    rm(TOP)
    gc()
    if(toupper(b$LUNIT) == "FT"){
        from_L <- 1000. / 2.54^3 / 12^3
    } else if(toupper(b$LUNIT) == "FEET"){
        from_L <- 1000. / 2.54^3 / 12^3
    } else if(toupper(b$LUNIT) == "FOOT"){
        from_L <- 1000. / 2.54^3 / 12^3
    } else if(toupper(b$LUNIT) == "M"){
        from_L_ <- 1000. / 100^3
    } else if(toupper(b$LUNIT) == "METER"){
        from_L_ <- 1000. / 100^3
    } else if(toupper(b$LUNIT) == "METERS"){
        from_L_ <- 1000. / 100^3
    } else if(toupper(b$LUNIT) == "CM"){
        from_L_ <- 1000.
    } else{
        print("LENGTH UNITS CAN BE ft, m, cm")
        stop("LENGTH UNITS DON'T MATCH\n CHECK THE BTN FILE")
        }

    if(toupper(b$MUNIT) == "MG"){
        to_lbs <- 1. / 1000 * 2.2046226218
    } else if(toupper(b$MUNIT) == "LB"){
        to_lbs <- 1.
    } else if(toupper(b$MUNIT) == "LBS"){
        to_lbs <- 1.
    } else{
        to_lbs <- 1. / 10^6 / 1000. * 2.2046226218
        print("MASS UNITS ARE ASSUMED TO BE micrograms")
        print("IF THIS IS NOT THE CASE, MAKE THE CORRECTION")
        print("IN THE MASS DATA FRAME")
    }

    if(toupper(b$TUNIT) == "D"){
        to_yrs <- 1. / 365
    } else if(toupper(b$TUNIT) == "DAYS"){
        to_yrs <- 1. / 365
    } else if(toupper(b$TUNIT) == "DAY"){
        to_yrs <- 1. / 365
    } else if(toupper(b$TUNIT) == "H"){
        to_yrs <- 1. / 24 / 365
    } else if(toupper(b$TUNIT) == "HOUR"){
        to_yrs <- 1. / 24 / 365
    } else if(toupper(b$MUNIT) == "HOURS"){
        to_yrs <- 1. / 24 / 365
    } else if(toupper(b$TUNIT) == "S"){
        to_yrs <- 1. / 60 / 24 / 365
    } else if(toupper(b$TUNIT) == "SEC"){
        to_yrs <- 1. / 60 / 24 / 365
    } else if(toupper(b$MUNIT) == "SECS"){
        to_yrs <- 1. / 60 / 24 / 365
    } else if(toupper(b$TUNIT) == "Y"){
        to_yrs <- 1.
    } else if(toupper(b$TUNIT) == "YRS"){
        to_yrs <- 1.
    } else if(toupper(b$MUNIT) == "YEAR"){
        to_yrs <- 1.
    } else{
        stop("TIME UNITS DON'T MATCH\n CHECK THE BTN FILE")
    }

    TIMPRS_YEARS <- b$TIMPRS * to_yrs
    rm(b)
    gc()
    h <- MFtools::readhds(HDS, NLAY, NSP) %>%
         dplyr::mutate(YEARS = TIME * to_yrs)

    h$GWE[h$GWE == 999] <- -10^6                        # Index and filter this way to improve speed

    h %<>% dplyr::mutate(THICK = ifelse(LAY == 1, GWE - BOTL1, dZ$dZ)) %>%
           dplyr::mutate(THICK = ifelse(THICK < 0, 0, THICK))

    FLWYRS <- h %>% dplyr::group_by(YEARS) %>% dplyr::summarise(TIME = mean(YEARS)) %>% dplyr::select(YEARS)
    h %<>% dplyr::select(STP, LAY, ROW, COL, THICK) %>% dplyr::rename(PER = STP)

    TRANSYRS <- TIMPRS_YEARS %>% tibble::data_frame(YEARS = .)
    NTTS <- dplyr::full_join(FLWYRS, TRANSYRS, by = "YEARS") %>% nrow() %>% as.integer()
    dX <- dX %>% rep(NROW) %>% rep(NLAY) %>% rep(NTTS)
    dY <- dY %>% rep(each = NCOL) %>% rep(NLAY) %>% rep(NTTS)
    POR <- POR %>% rep(NTTS)

    MASS <- MFtools::readucn(UCN, NLAY, NTTS) %>%
            dplyr::mutate(YEARS = TIME * to_yrs) %>%
            dplyr::left_join(h, by = c("PER", "LAY", "ROW", "COL")) %>%
            dplyr::mutate(dX = dX) %>%
            dplyr::mutate(dY = dY) %>%
            dplyr::mutate(POR = POR) %>%
            dplyr::mutate(CONC = ifelse(CONC < 0 , 0, CONC)) %>%
            dplyr::mutate(MASS = dX * dY * POR * THICK * CONC / from_L * to_lbs) %>%
            dplyr::select(YEARS, LAY, ROW, COL, THICK, CONC, MASS)

    rm(h)
    rm(dX)
    rm(dY)
    rm(POR)
    rm(BOTL1)
    rm(THICK)
    gc()
    return(MASS)
    }


#' Fit a local model via the local adaptive group lasso
#'
#' This function augments the covariates with local interactions, drops
#' observations with zero weight, runs the adaptive grouped lasso, computes the
#' residuals, and returns the necessary values for tuning or reporting.
#'
#' @param x matrix of observed covariates
#' @param y vector of observed responses
#' @param loc location at which to fit a model
#' @param family exponential family distribution of the response
#' @param varselect.method criterion to minimize in the regularization step of
#'   fitting local models - options are \code{AIC}, \code{AICc}, \code{BIC},
#'   \code{GCV}
#' @param tuning logical indicating whether this model will be used to tune the
#'   bandwidth, in which case only the tuning criteria are returned
#' @param kernel.weights vector of observation weights from the kernel
#' @param prior.weights vector of prior observation weights provided by the user
#' @param longlat \code{TRUE} indicates that the coordinates are specified in
#'   longitude/latitude, \code{FALSE} indicates Cartesian coordinates. Default
#'   is \code{FALSE}.
#'
#' @return list of coefficients, nonzero coefficient identities, and tuning data
#' @useDynLib lagr
#'
lagr.fit.inner = function(x, y, group.id, coords, loc, family, varselect.method, oracle, tuning, predict, simulation, n.lambda, lambda.min.ratio, lagr.convergence.tol, lagr.max.iter, verbose, kernel.weights=NULL, prior.weights=NULL, longlat=FALSE) {
    #Find which observations were made at the model location
    colocated = which(apply(coords, 1, function(cc) all(round(cc,5) == round(as.numeric(loc),5))))

    #Bail now if only one observation has weight:
    if (sum(kernel.weights)==length(colocated)) {
        return(list('tunelist'=list('df-local'=1, 'ssr-loc'=list('pearson'=Inf, 'deviance'=Inf))))
    }

    #Use oracular variable selection if specified
    orig.names = colnames(x)
    if (!is.null(oracle)) {
        x = matrix(x[,oracle], nrow=nrow(x), ncol=length(oracle))
        colnames(x) = oracle
    }

    #Establish groups for the group lasso and if there's an intercept, mark it as unpenalized
    if (0 %in% group.id)
        unpen = 0
    raw.vargroup = group.id

    #This is the naming system for the covariate-by-location interaction variables.
    raw.names = colnames(x)
    interact.names = vector()
    for (l in 1:length(raw.names)) {
        for (m in 1:ncol(coords)) {
            interact.names = c(interact.names, paste(raw.names[l], ":", colnames(coords)[m], sep=""))
        }
    }

    #Compute the covariate-by-location interactions
    q = ncol(coords)
    interacted = matrix(0, ncol=q*ncol(x), nrow=nrow(x))
    for (k in 1:ncol(x)) {
        for (ll in 1:q) {
            interacted[,q*(k-1)+ll] = x[,k, drop=FALSE]*(coords[,ll]-loc[[ll]])
            group.id = c(group.id, group.id[k])
        }
    }
    x.interacted = cbind(x, interacted)
    colnames(x.interacted) = c(raw.names, interact.names)

    #Combine prior weights and kernel weights
    w <- prior.weights * kernel.weights
    weighted = which(w>0)
    n.weighted = length(weighted)

    #Limit our attention to the observations with nonzero weight
    xxx = as.matrix(x.interacted[weighted,, drop=FALSE])
    yyy = as.matrix(y[weighted])
    colocated = which(kernel.weights[weighted]==1)
    w = w[weighted]
    sumw = sum(w)

    #Instantiate objects to store our output
    tunelist = list()

    if (is.null(oracle)) {
        #Use the adaptive group lasso to produce a local model:
        model = grouplasso(data=list(x=xxx, y=yyy), weights=w, index=group.id, family=family, maxit=lagr.max.iter, delta=2, nlam=n.lambda, min.frac=lambda.min.ratio, thresh=lagr.convergence.tol, unpenalized=unpen)

        vars = apply(as.matrix(model$beta), 2, function(x) {which(x!=0)})
        df = model$results$df + 1 #Add one because we must estimate the scale parameter.
    } else {
        model = glm(yyy~xxx-1, weights=w, family=family)
        vars = list(1:ncol(xxx))
        varset = vars[[1]]
        df = ncol(xxx) + 1 #Add one for the scale parameter

        fitted = model$fitted
        localfit = fitted[colocated]
        dispersion = summary(model)$dispersion
        k = 1

        #Estimating scale in penalty formula:
        loss = sumw * log(sum(w * model$residuals**2)) - log(sumw) + 1
    }

    if (sumw > ncol(x)) {
        if (is.null(oracle)) {
            #Extract the fitted values for each lambda:
            dispersion = model$results$dispersion

            #Using the grouplasso's criteria:
            loss = model$results[[varselect.method]]

            #Pick the lambda that minimizes the loss:
            k = which.min(loss)
            localfit = model$results$fitted[colocated,]
            df = df[k]
            if (k > 1) {
                varset = vars[[k]]
            } else {
                varset = NULL
            }
        }

        #Prepare some outputs for the bandwidth-finding scheme:
        tunelist[['localfit']] = localfit
        tunelist[['criterion']] = model$results[[varselect.method]]
        tunelist[['dispersion']] = dispersion
        tunelist[['n']] = sumw
        tunelist[['df']] = df
        tunelist[['df-local']] = length(colocated) * df / sumw

    } else {
        fitted = rep(meany, nrow(xxx))
        dispersion = 0
        loss = Inf
        loss.local = c(Inf)
        localfit = meany
    }

    #Get the coefficients:
    if (is.null(oracle)) {
        coefs = drop(model$beta)
        rownames(coefs) = colnames(xxx)

        #Use AIC weights, or not:
        if (varselect.method %in% c('wAIC','wAICc')) {
            #Big average based on a selection criterion:
            w = -model$results[[varselect.method]]
            w = matrix(w / sum(w))
            #coefs = (model$beta %*% w)[1:length(orig.names)]
            #conf.zero = drop((model$beta==0) %*% w)[1:length(orig.names)]
            coefs = drop(model$beta %*% w)
            conf.zero = drop((model$beta==0) %*% w)
        } else {
            #coefs = model$beta[1:length(orig.names),k]
            coefs = model$beta[,k]
            conf.zero = as.numeric(coefs==0)
            names(conf.zero) = names(coefs)
        }

        #list the covariates that weren't shrunk to zero, but don't bother listing the intercept.
        nonzero = raw.names[which(raw.vargroup %in% unique(group.id[which(conf.zero!=1)]))]
        nonzero = nonzero[nonzero != "(Intercept)"]

        #names(coefs) = raw.names
        #names(conf.zero) = colnames(raw.names)
        #names(coefs) = colnames(xxx)
        #names(conf.zero) = colnames(xxx)
    } else {
        #coefs = rep(0, length(orig.names))
        #names(coefs) = orig.names
        coefs = rep(0, ncol(xxx))
        names(coefs) = colnames(xxx)
        coefs[raw.names] = coef(model)[1:length(oracle)]
        nonzero = raw.names
        conf.zero = rep(0, length(orig.names))
        names(conf.zero) = colnames(raw.names)
    }

    if (tuning) {
        return(list(tunelist=tunelist, model=model, s=k, dispersion=dispersion, nonzero=nonzero, weightsum=sumw, loss=loss))
    } else if (predict) {
        return(list(tunelist=tunelist, coef=coefs, weightsum=sumw, s=k, dispersion=dispersion, nonzero=nonzero, conf.zero=conf.zero))
    } else if (simulation) {
        return(list(tunelist=tunelist, coef=coefs, s=k, dispersion=dispersion, fitted=localfit, nonzero=nonzero, conf.zero=conf.zero, actual=yyy[colocated], weightsum=sumw, loss=loss))
    } else {
        return(list(model=model, loss=loss, coef=coefs, nonzero=nonzero, conf.zero=conf.zero, s=k, loc=loc, df=df, loss.local=loss, dispersion=dispersion, fitted=localfit, weightsum=sumw, tunelist=tunelist))
    }
}


#' ---
#' title: "Script 3 of pipeline: read in workspace from script1, run beta diversity analysis"
#' author: "Francesco Vitali"
#' output: html_document
#' ---

#' ```{r setup library load, include=FALSE}

library(phyloseq)
library(tidyverse)
library(data.table)
library(ggsci)
library(ggpubr)
library(microbiome)
library(patchwork)
library(metagenomeSeq)
library(vegan)
library(reshape2)
library(psych)
library(corrplot)
library(rstatix)
library(pairwiseAdonis)

# red in workspace from script 1

load ("./WP3WP4_workspace")

palette_custom <- c("#1F78B4", "#E31A1C", "#FF7F00", "#33A02C")

#' knitr::opts_chunk$set(fig.width=unit(15,"cm"), fig.height=unit(11,"cm"))

#' ```

#' ```

#' *BACTERIA*

#############

#' **WP3 BACTERIA**

#############
#' ```{r betadiv bact WP3, include=TRUE, echo = FALSE}

# how to transform data for beta diversity analysis?

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP3_initial_bact), "data.frame"),
                 TotalReads = sample_sums(WP3_initial_bact), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)
# variation in read depth is 7X

# plot reads to find outliers

sdt %>%
  filter(AnimalID != "E149-40") %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  filter(AnimalID != "E149-40") %>%
  summary()

# NORMALIZATION: open problematic of which to choose

# see https://microbiomejournal.biomedcentral.com/articles/10.1186/s40168-017-0237-y
# see https://journals.plos.org/ploscompbiol/article?id=10.1371/journal.pcbi.1003531
# see https://www.nature.com/articles/s41522-020-00160-w

# new kid on the block! : avgdist() supported by Schloss
# (see https://www.youtube.com/watch?v=xyufizOpc5I) also (https://www.youtube.com/watch?v=ht3AX5uZTTQ) also (https://www.youtube.com/watch?v=t5qXPIS-ECU)
# So, the whole thing is about rarefaction or not. He support rarefaction as is the only method that is removing some relation between BC distance and
# depth of sampling (n reads). To note, however, is that he is not doing the "classical" rarefaction (i.e. as in script2.r for alpha-div) using subsampling
# and replacement, as it is not that good, as it really all depends on the seed and on which sequences get subsampled.
# Instead, in the videos above, he use a nice combination of rarefaction and vegdist: he use rarefaction analysis followed by BC calculation multiple time,
# so that the final distance matrix is an average od the distance matrices obtained over the different replicates and the relation with n° seqs disappear, but
# without the risk of normal (single) rarefaction of loosing OTUs only by chance of the random procedure.
# So, he is using un-rarefied and un-transformed counts, but rather performs this normalization step at the level of distance calculation.
# From the video, and also conceptually, seems very convincing.

# CSS remain one of the most interesting and supported, but rarefaction is still an option.
# Evaluate both Bray and Jaccard eventually, in one case to evaluate changes in abundance, in the other
# changes as presence/absence

# Data driven evaluation: transform with rarefaction and with CSS, calculate bray and jaccard, compare with Mantel

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP3.bact.ASVprev <- prevalence(subset_samples(WP3_initial_bact, AnimalID != "E149-40"), detection=0, sort=TRUE, count=F)
summary(names(WP3.bact.ASVprev[WP3.bact.ASVprev > 0.1]))
summary(names(WP3.bact.ASVprev[WP3.bact.ASVprev < 0.1]))
# create an object with only the ASV in more than 10% of samples
WP3_initial_bact_prevalence <- prune_taxa(names(WP3.bact.ASVprev[WP3.bact.ASVprev > 0.1]), subset_samples(WP3_initial_bact, AnimalID != "E149-40"))
#check
min(prevalence(WP3_initial_bact_prevalence, detection=0, sort=TRUE, count=F))

# rarefaction on the full dataset
WP3_raref_bact<- rarefy_even_depth(subset_samples(WP3_initial_bact, AnimalID != "E149-40"),
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(subset_samples(WP3_initial_bact, AnimalID != "E149-40")))),
                                   replace=F)

# rarefaction on the prevalence dataset
WP3_raref_bact.prevalence<- rarefy_even_depth(subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40"),
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40")))),
                                   replace=F)

# CSS scaling (not removing singletons) on the full dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(subset_samples(WP3_initial_bact, AnimalID != "E149-40"))
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP3_CSS_bact <- subset_samples(WP3_initial_bact, AnimalID != "E149-40")
otu_table(WP3_CSS_bact) <- otu_table(data.CSS, taxa_are_rows = T)

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40"))
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP3_CSS_bact.prevalence <- subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40")
otu_table(WP3_CSS_bact.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

# calculate distance matrices
bray_WP3_raref <- phyloseq::distance(WP3_raref_bact, "bray")
bray_WP3_CSS <- phyloseq::distance(WP3_CSS_bact, "bray")

bray_WP3_raref.prevalence <- phyloseq::distance(WP3_raref_bact.prevalence, "bray")
bray_WP3_CSS.prevalence <- phyloseq::distance(WP3_CSS_bact.prevalence, "bray")

# check if order of the matrix is the same
summary(melt(as.matrix(bray_WP3_raref))[1] == melt(as.matrix(bray_WP3_CSS))[1])

# perform mantel test
set.seed(35264)
mantel(xdis = bray_WP3_CSS, ydis = bray_WP3_raref, permutations = 999, method = "pearson")

set.seed(35264)
mantel(xdis = bray_WP3_CSS, ydis = bray_WP3_CSS.prevalence, permutations = 999, method = "pearson")

set.seed(35264)
mantel(xdis = bray_WP3_raref, ydis = bray_WP3_raref.prevalence, permutations = 999, method = "pearson")

mds.css <- monoMDS(bray_WP3_CSS)
mds.raref <- monoMDS(bray_WP3_raref)
WP3.bact.proc <- procrustes(mds.raref, mds.css)
summary(WP3.bact.proc)
plot(WP3.bact.proc)

# see if biological interpretation is the same or not
df <- as(sample_data(WP3_CSS_bact), "data.frame")
perm <- how(nperm = 999)
setBlocks(perm) <- with(df, AnimalID)

set.seed(12387)
adonis2(bray_WP3_CSS ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)
set.seed(12387)
adonis2(bray_WP3_CSS.prevalence ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)

set.seed(12387)
adonis2(bray_WP3_raref ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)
set.seed(12387)
adonis2(bray_WP3_raref.prevalence ~ Time * Diet * Sacrif_dfference, data = df, permutations = perm)

# significance and R2 only show minor changes, but the Mantel correl between the two dist matrices is not high
# overall, higher R2 in all factors (time diet and sacrifice difference) with CSS.prevalence dataset

# This set the basis of choosing the CSS transformation on the prevalence (10%) filtered dataset as this seems
# to show higher power to discriminate over the exp factors

# Perform ordination now

# NMDS
set.seed(34624)
WP3_bact_ord <- ordinate(WP3_CSS_bact.prevalence, "NMDS", distance = "bray")
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Diet, shape = Time)) #+ geom_text(mapping = aes(label = Gender), size = 3, nudge_x = 0.015, nudge_y = -0.015)
p.WP3_bact_ord <- p.WP3_bact_ord + theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("Dim1") + ylab("Dim2") + labs( fill = "Diet") + theme(legend.position="right")

p.WP3_bact_ord

df <- as(sample_data(WP3_CSS_bact.prevalence), "data.frame")
perm <- how(nperm = 999)
setBlocks(perm) <- with(df, AnimalID)

bray_WP3_CSS.prevalence <- phyloseq::distance(WP3_CSS_bact.prevalence, "bray")

set.seed(12387)
adonis2(bray_WP3_CSS.prevalence ~ Time + Diet + Sacrif_dfference, data = df, permutations = perm)

# NMDS with Schloss approach

# starting data is the untransformed DF, will still remove the lower outlier and remove low prevalence OTUs
phylo_schloss <- subset_samples(WP3_initial_bact_prevalence, AnimalID != "E149-40")
otu_table_schloss <- otu_table(phylo_schloss)@.Data

otu_table_schloss %>%
  t() %>%
  as.data.frame() -> otu_table_schloss

# adding some metadata
row.names(otu_table_schloss) == row.names(sample_data(phylo_schloss))
otu_table_schloss <- cbind(sample_data(phylo_schloss)[,3:4], otu_table_schloss)

# calculate depth
nSeqs <- min(sample_sums(phylo_schloss))

# calculate rarefaction of BC distance and plot MDS
set.seed(43655826)
raref_BC <- avgdist(x = otu_table_schloss[,-c(1,2)], sample = nSeqs, dmethod = "bray", iterations = 100)
set.seed(62853)
schloss_MDS <- metaMDS(raref_BC)

scores(schloss_MDS) %>%
  as_tibble(rownames = "Group") %>%
  ggplot(aes(x = NMDS1, y = NMDS2)) +
  geom_point(size = 5, stroke = 0.8, aes(fill = otu_table_schloss$Diet, shape = otu_table_schloss$Time))+
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("Dim1") + ylab("Dim2") + labs( fill = "Diet") + theme(legend.position="right")

# PCOA

WP3_CSS_bact.prevalenceT3 <- subset_samples(WP3_CSS_bact.prevalence, Time == "T3")

WP3_bact_ord <- ordinate(WP3_CSS_bact.prevalenceT3, "PCoA", distance = "bray")
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalenceT3, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord +
  geom_point(size = 3, stroke = 0.8, aes(fill = Diet), shape = 22)
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  xlab("PCoA1 (17.4%)") +
  ylab("PCoA2 (11.6%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_1

p.WP3_bact_ord -> p.WP3_bact_ord_final

# pairwise adonis
df <- as(sample_data(WP3_CSS_bact.prevalenceT3), "data.frame")
d.bacteria = phyloseq::distance(WP3_CSS_bact.prevalenceT3, "bray")
set.seed(12387)
pw_ad_bactT3 <- pairwise.adonis(d.bacteria, factors = df$Diet, p.adjust.m = "BH", perm = 999)

pw_ad_bactT3$R2

# PCoA using the Schloss avgdist method
WP3_bact_ord <- ordinate(phylo_schloss, "PCoA",distance = raref_BC)
p.WP3_bact_ord <- plot_ordination(physeq = phylo_schloss, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Diet, shape = Time))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("PCoA1 (21.2%)") +
  ylab("PCoA2 (8.6%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_1

# plot on distance from sacrifice
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Sacrif_dfference, shape = Time))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_viridis_c(option = "C") +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("PCoA1 (17.3%)") +
  ylab("PCoA2 (11.5%)") +
  labs(fill = "Days from \nfirst sacrif.", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_2

p.WP3_bact_ord_1 / p.WP3_bact_ord_2 -> p_suppl_ordi

ggsave('./Supplementary figure 2.png', p_suppl_ordi)

# Which component capture best experimental factors?

plot_scree(WP3_bact_ord, title = NULL)

# extract coordinates on the first 20 axis, mount a df with exp factors
df <- as(sample_data(WP3_CSS_bact.prevalence), "data.frame")
ordi.coordinates <- as.data.frame(WP3_bact_ord$vectors[,1:10])
row.names(df) == row.names(ordi.coordinates) # row name is in same order
ordi.coordinates <- cbind(ordi.coordinates, df[,c(3,4,9:14)]) # attach some variables

# BEST AXIS FOR TIME
ordi.coordinates %>%
  wilcox_effsize(Axis.1 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.2 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.3 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.4 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.5 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.6 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.7 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.8 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.9 ~ Time)
ordi.coordinates %>%
  wilcox_effsize(Axis.10 ~ Time)

ordi.coordinates %>%
  wilcox_test(Axis.1 ~ Time)
ordi.coordinates %>%
  wilcox_test(Axis.2 ~ Time)

# BEST AXIS FOR Diet
ordi.coordinates %>%
  wilcox_effsize(Axis.1 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.2 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.3 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.4 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.5 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.6 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.7 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.8 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.9 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.10 ~ Diet)

## Other numeric variables with correlation

ordi.coordinates %>%
  select(-c(Diet, start_body_weight, Time)) %>%
  corr.test(scale(.),method = "spearman", adjust = "none") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r),  order="original", method = "number",tl.cex = 0.8,number.cex = 1, type = "lower",
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

# Maybe it has more sense to see beta diversity at T3, where the diet should have had an effect

WP3_CSS_bact.prevalence.T3 <- subset_samples(WP3_CSS_bact.prevalence, Time == "T3") %>% prune_taxa(taxa_sums(.) > 0, .)

# PCOA
WP3_bact_ord <- ordinate(WP3_CSS_bact.prevalence.T3, "PCoA", distance = "bray")
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence.T3, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, shape = 21, aes(fill = Diet))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  xlab("PCoA1 (17.4%)") +
  ylab("PCoA2 (11.6%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23)))  -> p.WP3_bact_ord.T3

p.WP3_bact_ord

## With Schloss
# starting data is the untransformed DF, will still remove the lower outlier and remove low prevalence OTUs
phylo_schloss <- subset_samples(subset_samples(WP3_initial_bact_prevalence, Time == "T3"), AnimalID != "E149-40")
otu_table_schloss <- otu_table(phylo_schloss)@.Data

otu_table_schloss %>%
  t() %>%
  as.data.frame() -> otu_table_schloss

# adding some metadata
row.names(otu_table_schloss) == row.names(sample_data(phylo_schloss))
otu_table_schloss <- cbind(sample_data(phylo_schloss)[,3:4], otu_table_schloss)

# calculate depth
nSeqs <- min(sample_sums(phylo_schloss))

# calculate rarefaction of BC distance and plot MDS
set.seed(43655826)
raref_BC <- avgdist(x = otu_table_schloss[,-c(1,2)], sample = nSeqs, dmethod = "bray", iterations = 100)

# PCoA using the Schloss avgdist method
WP3_bact_ord <- ordinate(phylo_schloss, "PCoA",distance = raref_BC)
  p.WP3_bact_ord <- plot_ordination(physeq = phylo_schloss, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8, aes(fill = Diet, shape = Time))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(21,22,23,24))+
  xlab("PCoA1 (24.1%)") +
  ylab("PCoA2 (12.3%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord_1

# see if biological interpretation is the same or not
bray_WP3_CSS.prevalence.T3 <- phyloseq::distance(WP3_CSS_bact.prevalence.T3, "bray")
df <- as(sample_data(WP3_CSS_bact.prevalence.T3), "data.frame")
set.seed(12387)
adonis2(bray_WP3_CSS.prevalence.T3 ~ Diet + Sacrif_dfference + end_body_weight, data = df, permutations = 999)

# plot on distance from sacrifice
p.WP3_bact_ord <- plot_ordination(physeq = WP3_CSS_bact.prevalence.T3, WP3_bact_ord, axes = c(1,2))
p.WP3_bact_ord <- p.WP3_bact_ord + geom_point(size = 5, stroke = 0.8,shape = 21, aes(fill = Sacrif_dfference))
p.WP3_bact_ord <- p.WP3_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_viridis_c(option = "C") +
  xlab("PCoA1 (17.3%)") +
  ylab("PCoA2 (11.5%)") +
  labs(fill = "Days from \nfirst sacrif.", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP3_bact_ord.T3

# Which component capture best experimental factors?

plot_scree(WP3_bact_ord, title = NULL)

# extract coordinates on the first 20 axis, mount a df with exp factors
df <- as(sample_data(WP3_CSS_bact.prevalence.T3), "data.frame")
ordi.coordinates <- as.data.frame(WP3_bact_ord$vectors[,1:10])
row.names(df) == row.names(ordi.coordinates) # row name is in same order
ordi.coordinates <- cbind(ordi.coordinates, df[,c(4,9:14)]) # attach some variables

# for sacrifice difference and other numeric var, I could do a scatterplot matrix

ordi.coordinates %>%
  select(-c(Diet, start_body_weight)) %>%
  corr.test(scale(.),method = "spearman", adjust = "none") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r),  order="original", method = "number",tl.cex = 0.8,number.cex = 1,
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

# sacrifice difference strongly correlate with axis.2

# BEST AXIS FOR Diet

ordi.coordinates %>%
  wilcox_test(Axis.1 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.2 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.3 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.4 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.5 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.6 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.7 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.8 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.9 ~ Diet)
ordi.coordinates %>%
  wilcox_test(Axis.10 ~ Diet)

# axis 1:5 have a significant anova respect to diet, should calculate which has the higher effect size

ordi.coordinates %>%
  wilcox_effsize(Axis.1 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.2 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.3 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.4 ~ Diet)
ordi.coordinates %>%
  wilcox_effsize(Axis.5 ~ Diet)

#############

#' **WP4 BACTERIA**

###########

#' ```{r betadiv bact WP4, include=TRUE, echo = FALSE}

# Optimization of transformation and of methods was performed only for WP3, here take the same

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP4_initial_bact), "data.frame"),
                 TotalReads = sample_sums(WP4_initial_bact), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)

# plot reads to find outliers

sdt %>%
  filter(AnimalID != "WP4-928") %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  filter(AnimalID != "WP4-928") %>%
  summary()

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP4.bact.ASVprev <- prevalence(subset_samples(WP4_initial_bact, AnimalID != "WP4-928"), detection=0, sort=TRUE, count=F)
summary(names(WP4.bact.ASVprev[WP4.bact.ASVprev > 0.1]))
summary(names(WP4.bact.ASVprev[WP4.bact.ASVprev < 0.1]))
# create an object with only the ASV in more than 10% of samples
WP4_initial_bact_prevalence <- prune_taxa(names(WP4.bact.ASVprev[WP4.bact.ASVprev > 0.1]), subset_samples(WP4_initial_bact, AnimalID != "WP4-928"))
#check
min(prevalence(WP4_initial_bact_prevalence, detection=0, sort=TRUE, count=F))

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(subset_samples(WP4_initial_bact_prevalence, AnimalID != "WP4-928"))
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP4_CSS_bact.prevalence <- subset_samples(WP4_initial_bact_prevalence, AnimalID != "WP4-928")
otu_table(WP4_CSS_bact.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

# Perform ordination now
# PCOA

WP4_bact_ord <- ordinate(WP4_CSS_bact.prevalence, "PCoA", distance = "bray")
p.WP4_bact_ord <- plot_ordination(physeq = WP4_CSS_bact.prevalence, WP4_bact_ord, axes = c(1,2))
p.WP4_bact_ord <- p.WP4_bact_ord + geom_point(size = 3, stroke = 0.8, aes(fill = Inoculum_diet, shape = Time))
p.WP4_bact_ord <- p.WP4_bact_ord +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(24,21,22,23))+
  xlab("PCoA1 (24%)") +
  ylab("PCoA2 (14.5%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) -> p.WP4_bact_ord_1

## Plot with WP3
figure2 <- p.WP3_bact_ord_final / p.WP4_bact_ord + plot_layout(guides = "collect") & theme(legend.position = 'left')

#ggsave('./Figure 2.png', figure2)

# pairwise adonis
df <- as(sample_data(subset_samples(WP4_CSS_bact.prevalence, Time == "T3" & Type != "Inoculum")), "data.frame")
d.bacteria = phyloseq::distance(subset_samples(WP4_CSS_bact.prevalence, Time == "T3"  & Type != "Inoculum"), "bray")
set.seed(12387)
pw_ad_bactWP4 <- pairwise.adonis(d.bacteria, factors = df$Diets, p.adjust.m = "BH", perm = 999)

mat1 <- data.frame(matrix(nrow=4,ncol=4,byrow=TRUE))

mat1[1,1] <- 0
mat1[1,2] <- pw_ad_bactT3$R2[1]
mat1[1,3] <-pw_ad_bactT3$R2[2]
mat1[1,4] <-pw_ad_bactT3$R2[4]
mat1[2,1] <- pw_ad_bactT3$R2[1]
mat1[2,2] <- 0
mat1[2,3] <-pw_ad_bactT3$R2[4]
mat1[2,4] <-pw_ad_bactT3$R2[5]
mat1[3,1] <-pw_ad_bactT3$R2[2]
mat1[3,2] <- pw_ad_bactT3$R2[4]
mat1[3,3] <- 0
mat1[3,4] <-pw_ad_bactT3$R2[6]
mat1[4,1] <- pw_ad_bactT3$R2[3]
mat1[4,2] <- pw_ad_bactT3$R2[5]
mat1[4,3] <-pw_ad_bactT3$R2[6]
mat1[4,4] <- 0

colnames(mat1) <- c("MBDT", "PVD", "MBD", "CTR")
row.names(mat1) <- c("MBDT", "PVD", "MBD", "CTR")

corrplot(as.matrix(mat1), type = "lower", diag = F, method = 'number', col = "black")

###########

#' **WP3 WP4 BACTERIA**

###########

# here analysis of WP3 at T3 and WP4 all timepoint, to highlight the "passage" in the FTM
# optionally, one could select only the ID that actually were used for the pool

WP3WP4_initial_bact <- subset_samples(phyloseq_obj_initial_bact,
                                      AnimalID != "E149-40" &  AnimalID != "WP4-928") %>% prune_taxa(taxa_sums(.) > 0, .)

# select sample subset of interest (i.e. only T3 of WP3)

WP3WP4_initial_bact <- subset_samples(WP3WP4_initial_bact, WP != "WP3" | Time != "T0")

# obtain rarefied object for alpha diversity

WP3WP4_raref_bact<- rarefy_even_depth(WP3WP4_initial_bact,
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(WP3WP4_initial_bact))),
                                   replace=F)

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP3WP4_initial_bact), "data.frame"),
                 TotalReads = sample_sums(WP3WP4_initial_bact), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)

# plot reads to find outliers

sdt %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  summary()

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP34.bact.ASVprev <- prevalence(WP3WP4_initial_bact, detection=0, sort=TRUE, count=F)
summary(names(WP34.bact.ASVprev[WP34.bact.ASVprev > 0.1]))
summary(names(WP34.bact.ASVprev[WP34.bact.ASVprev < 0.1]))
# create an object with only the ASV in more than 10% of samples
WP34_initial_bact_prevalence <- prune_taxa(names(WP34.bact.ASVprev[WP34.bact.ASVprev > 0.1]), WP3WP4_initial_bact)
#check
min(prevalence(WP34_initial_bact_prevalence, detection=0, sort=TRUE, count=F))

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(WP34_initial_bact_prevalence)
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP34_CSS_bact.prevalence <- WP34_initial_bact_prevalence
otu_table(WP34_CSS_bact.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

sample_data(WP34_CSS_bact.prevalence)$Time

WP34_bact_ord <- ordinate(WP34_CSS_bact.prevalence, "PCoA", distance = "bray")
p.WP34_bact_ord <- plot_ordination(physeq = WP34_CSS_bact.prevalence, WP34_bact_ord, axes = c(1,2))
p.WP34_bact_ord <- p.WP34_bact_ord +
  geom_point(size = 3, stroke = 0.8, aes(fill = Diets, shape = Time))+
  #geom_line(aes(group = AnimalID)) +
  geom_vline(xintercept= 0, linetype="dotted") +
  geom_hline(yintercept= 0, linetype="dotted") +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(24,21,22,25))+
  xlab("PCoA1 (24.1%)") +
  ylab("PCoA2 (11.9%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) +
  theme(legend.position="none")

p.WP34_bact_ord

# Calculate alpha-div
# richness
alphadiv_WP34_bact <- microbiome::richness(WP3WP4_raref_bact)
df <- as(sample_data(WP3WP4_raref_bact), "data.frame")
df <- cbind(df, alphadiv_WP34_bact)

row.names(alphadiv_WP34_bact$vectors) == row.names(df)

df <- cbind(df, WP34_bact_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Richness (n° of observed ASVs)")

ggscatter(data = df, x = "Axis.2", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Richness (n° of observed ASVs)")

ggboxplot(data = df, x = "WP", y = "observed", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = 100) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Richness (n° of observed ASVs)") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_b_ord

# evenness
alphadiv_WP34_bact <- microbiome::evenness(WP3WP4_raref_bact)
df <- as(sample_data(WP3WP4_raref_bact), "data.frame")
df <- cbind(df, alphadiv_WP34_bact)

row.names(alphadiv_WP34_bact$vectors) == row.names(df)

df <- cbind(df, WP34_bact_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Richness (n° of observed ASVs)")

ggscatter(data = df, x = "Axis.2", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Richness (n° of observed ASVs)")

ggboxplot(data = df, x = "WP", y = "pielou", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = .3, label.x = 2) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Pielou's Evenness") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_b_ord_eve

## Plot with other single

figure2 <- p.WP34_bact_ord + p.WP3_bact_ord_final/p.WP4_bact_ord + plot_layout(guides = "collect") & theme(legend.position = 'bottom')

#ggsave('./Figure 2.png', figure2)

layout <- "
A
A
A
B
C
"

p.WP34_bact_ord / sottoplot_b_ord / sottoplot_b_ord_eve+
  plot_layout(design = layout) -> panel_ord_bact

#####

#' *FUNGI*

#' **WP3 FUNGI**

#' ```{r betadiv fungi WP3, include=TRUE, echo = FALSE}

#' **WP4 FUNGI**

#' ```{r betadiv fungi WP4, include=TRUE, echo = FALSE}

# how to transform data for alpha diversity analysis?

#########################
#' **WP3 WP4 FUNGI**
######################

# here analysis of WP3 at T3 and WP4 all timepoint, to highlight the "passage" in the FTM
# optionally, one could select only the ID that actually were used for the pool

WP3WP4_initial_fung <- subset_samples(phyloseq_obj_initial_fungi,
                                      AnimalID != "E149-40" &  AnimalID != "WP4-928") %>% prune_taxa(taxa_sums(.) > 0, .)

# select sample subset of interest (i.e. only T3 of WP3)

WP3WP4_initial_fung <- subset_samples(WP3WP4_initial_fung, WP != "WP3" | Time != "T0")

# obtain rarefied object for alpha diversity

WP3WP4_raref_fung<- rarefy_even_depth(WP3WP4_initial_fung,
                                      rngseed=1234,
                                      sample.size=round(0.99*min(sample_sums(WP3WP4_initial_fung))),
                                      replace=F)

# calculate the variation in read obtained per sample
sdt = data.table(as(sample_data(WP3WP4_initial_fung), "data.frame"),
                 TotalReads = sample_sums(WP3WP4_initial_fung), keep.rownames = TRUE)
summary(sdt$TotalReads)
max(sdt$TotalReads)/min(sdt$TotalReads)

# plot reads to find outliers

sdt %>%
  ggboxplot(.,y = "TotalReads")

sdt %>%
  summary()

# generate a 10% prevalece filter dataset (see https://www.nature.com/articles/s41467-022-28034-z)

# calculate prevalence for each ASV
WP34.fung.ASVprev <- prevalence(WP3WP4_initial_fung, detection=0, sort=TRUE, count=F)
summary(names(WP34.fung.ASVprev[WP34.fung.ASVprev > 0.01]))
summary(names(WP34.fung.ASVprev[WP34.fung.ASVprev < 0.01]))
# create an object with only the ASV in more than 10% of samples
WP34_initial_fung_prevalence <- prune_taxa(names(WP34.fung.ASVprev[WP34.fung.ASVprev > 0.1]), WP3WP4_initial_fung)
#check
min(prevalence(WP34_initial_fung_prevalence, detection=0, sort=TRUE, count=F))

# CSS scaling (not removing singletons) on the prevalence dataset
data.metagenomeSeq = phyloseq_to_metagenomeSeq(WP34_initial_fung_prevalence)
p = cumNormStat(data.metagenomeSeq) #default is 0.5
data.cumnorm = cumNorm(data.metagenomeSeq, p=p)
#data.cumnorm
data.CSS = MRcounts(data.cumnorm, norm=TRUE, log=TRUE)
WP34_CSS_fung.prevalence <- WP34_initial_fung_prevalence
otu_table(WP34_CSS_fung.prevalence) <- otu_table(data.CSS, taxa_are_rows = T)

sample_data(WP34_CSS_fung.prevalence)$Time

# Ordination and plot

WP34_fung_ord <- ordinate(WP34_CSS_fung.prevalence, "PCoA", distance = "bray")
p.WP34_fung_ord <- plot_ordination(physeq = WP34_CSS_fung.prevalence, WP34_fung_ord, axes = c(1,2))
p.WP34_fung_ord <- p.WP34_fung_ord +
  geom_point(size = 3, stroke = 0.8, aes(fill = Diets, shape = Time))+
  #geom_line(aes(group = AnimalID)) +
  geom_vline(xintercept= 0, linetype="dotted") +
  geom_hline(yintercept= 0, linetype="dotted") +
  theme_bw() +
  theme( panel.grid.major =  element_blank(),
         panel.grid.minor =  element_blank()) +
  scale_fill_manual(values = palette_custom) +
  scale_shape_manual(values = c(24,21,22,25))+
  xlab("PCoA1 (40.9%)") +
  ylab("PCoA2 (5.4%)") +
  labs(fill = "Diet", shape = "Time") +
  theme(legend.position="right") +
  guides(fill = guide_legend(override.aes = list(shape = 23))) +
  theme(legend.position="none")

p.WP34_fung_ord

# Calculate alpha-div
alphadiv_WP34_fung <- microbiome::richness(WP3WP4_raref_fung)
df <- as(sample_data(WP3WP4_raref_fung), "data.frame")
df <- cbind(df, alphadiv_WP34_fung)

row.names(WP34_fung_ord$vectors) == row.names(df)

df <- cbind(df, WP34_fung_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Richness (n° of observed ASVs)")

ggscatter(data = df, x = "Axis.2", y = "observed", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Richness (n° of observed ASVs)")

ggboxplot(data = df, x = "WP", y = "observed", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = 90) +
  #ggtitle(label = "Fungi", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Richness (n° of observed ASVs)") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_f_ord

# evenness
alphadiv_WP34_fung <- microbiome::evenness(WP3WP4_raref_fung)
df <- as(sample_data(WP3WP4_raref_fung), "data.frame")
df <- cbind(df, alphadiv_WP34_fung)

row.names(alphadiv_WP34_fung$vectors) == row.names(df)

df <- cbind(df, WP34_fung_ord$vectors[,1:2])

ggscatter(data = df, x = "Axis.1", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA1") +
  ylab("Pielou's Evenness")

ggscatter(data = df, x = "Axis.2", y = "pielou", add = "reg.line", add.params = list(linetype = "dotted")) +
  stat_cor(method = "pearson") +
  xlab("PCoA2") +
  ylab("Pielou's Evenness")

ggboxplot(data = df, x = "WP", y = "pielou", add = "jitter",
          fill = "WP", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(label.y = .2, label.x = 2) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  xlab("") +
  ylab("Pielou's Evenness") +
  coord_flip() +
  theme(legend.position="none") -> sottoplot_f_ord_eve

layout <- "
A
A
A
B
C
"

p.WP34_fung_ord / sottoplot_f_ord / sottoplot_f_ord_eve+
  plot_layout(design = layout) -> panel_ord_fung

ggarrange(panel_ord_bact, panel_ord_fung,
          labels = c("A", "B"),
          ncol = 2) -> figure2

ggsave('./Figure 2.png', figure2)

#' ```

#' ```{r write images, include=FALSE}
#' knitr::opts_chunk$set(echo = TRUE)

# use ggsave for images

#' ```


[[[[[
   FUNDAMENTAL DECOMPOSITION
   We prove here that
      H(y|x) <= H_C(x,y) - H(x) + c
]]]]]

define (all-together x*)

let c debug 100 [constant to satisfy Kraft (see lemma)]

let x debug run-utm-on debug x*

let H-of-x debug length x*

[programs we've discovered that calculate pairs
 starting with x]
let programs nil

let (stage n)
    [generate requirements for all new programs we've
     discovered that produce (x y) pairs]
    let programs
        (add-to-set debug (halts? nil debug n) programs)
    (stage + n 1)

[at stage n = 0, 1, 2, 3, ...]
[look at all programs with <=n bits that halt within time n]
[returns list of all of them that produce pairs (x y)]
let (halts? p bits-left)
   let v try n C p [C is eval read-exp if C = U]
   if = success car v (look-at cadr v)
   if = 0 bits-left nil
   append (halts? append p cons 0 nil - bits-left 1)
          (halts? append p cons 1 nil - bits-left 1)

[returns (p) if C(p) = (x y), otherwise ()]
let (look-at v)
   if (and (is-pair v)
            = x car v ) cons p nil
      nil

[logical "and"]
let (and p q)
   if p q false

[is x a pair?]
let (is-pair? x)
   if atom x         false
   if atom cdr x     false
   if atom cdr cdr x true
                     false

[is an element in a set?]
let (is-in-set? element set)
   if atom set          false
   if = element car set true
   (is-in-set? element cdr set)

[forms set union avoiding duplicates,
 and makes requirement for each new find]
let (add-to-set new old)
   if  atom new  old
   let first-new car new
   let rest-new  cdr new
   if (is-in-set? first-new old) (add-to-set rest-new old)
   (do (make-requirement first-new)
       cons first-new (add-to-set rest-new old)
   )

[first argument discarded, done for side-effect only!]
let (do x y) y

[given new p such that C(p) = (x y),
 we produce the requirement for C_x
 that there be a program for y that is |p|-H(x)+c bits long]
let (make-requirement p)
   display cons cadr cadr try no-time-limit C p
           cons - + c length p H-of-x
                nil

let C ' [here eval read-exp gives U]
[test case special-purpose computer C here in place of U:]
[C(00100001) with x-1 and y-1 0's gives pair (x xy)]
[loop function gives number of bits up to next 1 bit]
   let (loop n)
      if = 1 read-bit n
      (loop + n 1)
   let x (loop 1)
   let y (loop 1)
   cons x cons * x y nil

[HERE GOES!]
(stage 0)

define      all-together
value       (lambda (x*) ((' (lambda (c) ((' (lambda (x) ((' (
            lambda (H-of-x) ((' (lambda (programs) ((' (lambda
             (stage) ((' (lambda (halts?) ((' (lambda (look-at
            ) ((' (lambda (and) ((' (lambda (is-pair?) ((' (la
            mbda (is-in-set?) ((' (lambda (add-to-set) ((' (la
            mbda (do) ((' (lambda (make-requirement) ((' (lamb
            da (C) (stage 0))) (' ((' (lambda (loop) ((' (lamb
            da (x) ((' (lambda (y) (cons x (cons (* x y) nil))
            )) (loop 1)))) (loop 1)))) (' (lambda (n) (if (= 1
             (read-bit)) n (loop (+ n 1)))))))))) (' (lambda (
            p) (display (cons (car (cdr (car (cdr (try no-time
            -limit C p))))) (cons (- (+ c (length p)) H-of-x)
            nil)))))))) (' (lambda (x y) y))))) (' (lambda (ne
            w old) (if (atom new) old ((' (lambda (first-new)
            ((' (lambda (rest-new) (if (is-in-set? first-new o
            ld) (add-to-set rest-new old) (do (make-requiremen
            t first-new) (cons first-new (add-to-set rest-new
            old)))))) (cdr new)))) (car new)))))))) (' (lambda
             (element set) (if (atom set) false (if (= element
             (car set)) true (is-in-set? element (cdr set)))))
            )))) (' (lambda (x) (if (atom x) false (if (atom (
            cdr x)) false (if (atom (cdr (cdr x))) true false)
            ))))))) (' (lambda (p q) (if p q false)))))) (' (l
            ambda (v) (if (and (is-pair v) (= x (car v))) (con
            s p nil) nil)))))) (' (lambda (p bits-left) ((' (l
            ambda (v) (if (= success (car v)) (look-at (car (c
            dr v))) (if (= 0 bits-left) nil (append (halts? (a
            ppend p (cons 0 nil)) (- bits-left 1)) (halts? (ap
            pend p (cons 1 nil)) (- bits-left 1))))))) (try n
            C p))))))) (' (lambda (n) ((' (lambda (programs) (
            stage (+ n 1)))) (add-to-set (debug (halts? nil (d
            ebug n))) programs))))))) nil))) (debug (length x*
            ))))) (debug (car (cdr (try no-time-limit (' (eval
             (read-exp))) (debug x*)))))))) (debug 100)))

define x* 3

define      x*
value       3

length bits x*

expression  (length (bits x*))
value       16

[give all-together x*]
try 60 cons cons "'
            cons all-together
            nil
       cons cons "'
            cons bits x*
            nil
       nil
    nil

expression  (try 60 (cons (cons ' (cons all-together nil)) (co
            ns (cons ' (cons (bits x*) nil)) nil)) nil)
debug       100
debug       (0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 0)
debug       3
debug       16
debug       0
debug       ()
debug       1
debug       ()
debug       2
debug       ()
debug       3
debug       ()
debug       4
debug       ((0 0 1 1))
debug       5
debug       ((0 0 1 0 1) (0 0 1 1))
debug       6
debug       ((0 0 1 0 0 1) (0 0 1 0 1) (0 0 1 1))
debug       7
debug       ((0 0 1 0 0 0 1) (0 0 1 0 0 1) (0 0 1 0 1) (0 0 1
            1))
debug       8
debug       ((0 0 1 0 0 0 0 1) (0 0 1 0 0 0 1) (0 0 1 0 0 1) (
            0 0 1 0 1) (0 0 1 1))
debug       9
value       (failure out-of-time ((3 88) (6 89) (9 90) (12 91)
             (15 92)))

define x* 4

define      x*
value       4

length bits x*

expression  (length (bits x*))
value       16

[give all-together x*]
try 60 cons cons "'
            cons all-together
            nil
       cons cons "'
            cons bits x*
            nil
       nil
    nil

expression  (try 60 (cons (cons ' (cons all-together nil)) (co
            ns (cons ' (cons (bits x*) nil)) nil)) nil)
debug       100
debug       (0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0)
debug       4
debug       16
debug       0
debug       ()
debug       1
debug       ()
debug       2
debug       ()
debug       3
debug       ()
debug       4
debug       ()
debug       5
debug       ((0 0 0 1 1))
debug       6
debug       ((0 0 0 1 0 1) (0 0 0 1 1))
debug       7
debug       ((0 0 0 1 0 0 1) (0 0 0 1 0 1) (0 0 0 1 1))
debug       8
debug       ((0 0 0 1 0 0 0 1) (0 0 0 1 0 0 1) (0 0 0 1 0 1) (
            0 0 0 1 1))
debug       9
value       (failure out-of-time ((4 89) (8 90) (12 91) (16 92
            )))