#' A generalised B-spline modelling for a set of neutral and trait-based variables
#'
#' This function implements the generalised B-spline model (*sensu* Lagat *et al.,* 2021b)
#' for dissecting the effects of random encounter versus functional trait mismatching on
#' multi-species co-occurrence and interference. Generalized linear model
#' (*sensu* Hastie and Tibshirani, 1986) with binomial variance distribution and log link
#' functions employed, with predictors transformed using a linear combination of B-splines
#' (*sensu* Curry and Schoenberg, 1988).
#'
#' @param s.data A species-by-site presence/absence `data.frame` with entries indicating
#' occurrence (1) and non-occurrence (0) of species in a site.
#' @param t.data A `data.frame` with traits as columns and species as rows. The species must be the same as in `s.data`.
#' @param p.d.mat A symmetric `matrix` with dimension names as species and entries indicating the
#' phylogenetic distance between any two of them (species).
#' @param d.f Degrees of freedom for B-splines.
#' @param order.jo Specific number of species for which the joint occupancy is computed. To implement
#' generalised B-spline modelling for multiple orders, see \link[msco]{gbsm_m.orders} function.
#' @param degree Degree of the B-splines.
#' @param metric The type of rescaling applied to the joint occupancy metric. Available options are:
#' `Simpson_eqn` for Simpson equivalent, `Sorensen_eqn` for Sorensen equivalent, `raw_prop` for the
#' raw form of the metric rescaled by dividing by the total number of sites, N, and `raw` for the
#' raw form of the metric without rescaling.
#' @param gbsm.model The model used if the `raw` form of the metric is choosen. Availbale options are `"quasipoisson"`
#' for quasipoisson GLM or `"nb"` for negative binomial GLM. Other metric types strictly uses binomial GLM.
#' @param n Number of samples for which the joint occupancy is computed. These samples are non-overlapping.
#' I.e., sampling is done without replacement. If the total number of combinations of `i` species chosen
#' from the total species pool `m`, i.e. `choose(m,i)`, is less than this value (`n`), `choose(m,i)` is
#' used as the (maximum) number of samples one can set. Otherwise sampling without replacement is
#' performed to select just the `n` samples.
#' @param b.plots Boolean value indicating if B-spline basis functions (of the first predictor) should be plotted.
#' @param response.curves A boolean value indicating if all response curves should be plotted.
#' @param leg Boolean value indicating if the legend of the gbsm outputs should be included in the plots. This
#' parameter is added to help control the appearance of plots in \link[msco]{gbsm_m.orders} function.
#' @param ylabel Boolean value indicating if the y label should be included in the response curves. This
#' parameter is added to help control the appearance of plots in \link[msco]{gbsm_m.orders} function.
#' @param scat.plot Boolean value indicating if scatter plots between joint occupancy and its predicted
#' values should be plotted.
#' @param start.range Range of starting values for glm regression.
#' @param max.vif This parameter is used to detect and avoid multi-collinearity among covariates. Its value can be varied
#' to have an intermediate GBSM model (based on GLM) with certain `VIF` values. Any predictor variable (from the
#' original model) with `VIF` greater than this value is removed. This can be repeated until an ideal `VIF` of
#' less or equal to a desired value is achieved.
#' @param max.vif2 Like `max.vif`, this parameter is used to detect and avoid multi-collinearity among covariates.
#' Its value can be varied to have a final GBSM model (based on GLM) with certain `VIF` values much less than `max.vif`.
#' Any predictor variable (from the intermediate model) with `VIF` greater than this value is removed. This
#' can be repeated until an ideal `VIF` of less or equal to a desired value is achieved.
#'
#' @return `gbsm` function returns a list containing the following outputs:
#' \item{`order.jo`}{Order of joint occupancy}
#' \item{`Predictors`}{Predictor variables used in GLM regression with binomial variance
#' distribution function and log link function.}
#' \item{`Responses`}{Response variables from GLM regression with binomial variance distribution
#' function and log link function.}
#' \item{`coeff`}{Coefficients of the generalized linear model used.}
#' \item{`glm_obj`}{Generalized linear model used.}
#' \item{`j.occs`}{Rescaled observed joint occupancies. See `metric`above.}
#' \item{`bs_pred`}{B-spline-transformed `Predictors`.}
#' \item{`var.expld`}{Amount of variation in joint occupancy explained by the `Predictors`. I.e.,
#' it is the Pearson's **\eqn{r^2}** between the observed and predicted values of joint occupancy.}
#' \item{`Original.VIFs`}{Variance inflation factors from the original GBSM model (before removing covariates exceeding `max.vif`).}
#' \item{`Intermediate.VIFs`}{Variance inflation factors from the intermediate GBSM model (after removing the 1st set of covariates exceeding `max.vif`).}
#' \item{`Final.VIFs`}{Variance inflation factors from the final GBSM model (after removing the 2nd set of covariates exceeding `max.vif2`).}
#' \item{`summary`}{summary of the regression results}
#'
#' @references
#' \enumerate{
#'
#' \item{Curry, H. B., and Schoenberg, I. J. (1988). On Pólya frequency functions IV: the
#' fundamental spline functions and their limits. In *IJ Schoenberg Selected Papers*
#' (pp. 347-383). Birkhäuser, Boston, MA. <https://doi.org/10.1007/978-1-4899-0433-1_17>}
#'
#' \item{Hastie, T., and Tibshirani, R. (1986). Generalized additive models. *Stat. Sci. 1*(3),
#' 297-310. <https://doi.org/10.1214/ss/1177013604>}
#'
#' \item{Lagat, V. K., Latombe, G. and Hui, C. (2021a). *A multi-species co-occurrence
#' index to avoid type II errors in null model testing*. DOI: `<To be added>`.}
#'
#' \item{Lagat, V. K., Latombe, G. and Hui, C. (2021b). *Dissecting the effects of random
#' encounter versus functional trait mismatching on multi-species co-occurrence and
#' interference with generalised B-spline modelling*. DOI: `<To be added>`.}
#' }
#'
#' @examples
#' \dontrun{
#' my.path <- system.file("extdata/gsmdat", package = "msco")
#' setwd(my.path)
#' s.data <- get(load("s.data.csv")) ## Species-by-site matrix
#' t.data <- get(load("t.data.csv")) ## Species-by-trait matrix
#' p.d.mat <- get(load("p.d.mat.csv")) ## Species-by-species phylogenetic distance matrix
#'
#' RNGkind(sample.kind = "Rejection")
#' set.seed(0)
#' my.gbsm <- msco::gbsm(s.data, t.data, p.d.mat, metric = "Simpson_eqn", gbsm.model,
#' d.f=4, order.jo=3, degree=3, n=1000, b.plots=TRUE, scat.plot=TRUE,
#' response.curves=TRUE, leg=1, max.vif = 10, max.vif2 = 3,
#' start.range=c(-0.1,0))
#'
#' head(my.gbsm$bs_pred)
#' head(my.gbsm$Predictors)
#' head(my.gbsm$Responses)
#' my.gbsm$order.jo
#' my.gbsm$var.expld
#' my.gbsm$Original.VIFs
#' my.gbsm$Intermediate.VIFs ## Resulting covariate VIFs after removing covariates with VIF > max.vif
#' my.gbsm$Final.VIFs ## Resulting covariate VIFs after removing covariates with VIF > max.vif2
#'
#' }
#'
#' @export
#' @md
gbsm <- function(s.data, t.data, p.d.mat, metric= "Simpson_eqn", d.f=4, order.jo=3, degree=3, n=1000, b.plots=TRUE,
gbsm.model, scat.plot=TRUE, response.curves=TRUE, ylabel=TRUE, leg=1, max.vif = 20, max.vif2 = 10,
start.range=c(-0.1,0)){
if(!is.null(t.data)){
if(class(t.data)!="data.frame"){
t.data <- as.data.frame(t.data)
}
}
if (order.jo > dim(s.data)[1]) {
stop("Wrong value for \"order\": it must be equal or lower than the number of species.")
}
if(!is.null(p.d.mat)){
if (!isSymmetric(as.matrix(p.d.mat))) {
stop("Distance matrix is not symmetrical")
}
}
if(!is.null(t.data)){
if(nrow(s.data)!=nrow(t.data)){
stop("s.data and t.data must have the same number of rows")
}
}
if(!is.null(p.d.mat)){
if(nrow(s.data)!=nrow(p.d.mat)){
stop("s.data and p.d.mat must have the same number of rows")
}
}
if(length(which(rowSums(s.data)==0))>0){
t.data<- t.data[-which(rowSums(s.data)==0),]
p.d.mat <- p.d.mat[-which(rowSums(s.data)==0),-which(rowSums(s.data)==0)]
s.data <- s.data[rowSums(s.data) > 0, ] ## Remove rows with no species
}else{
t.data <- t.data
s.data <- s.data
p.d.mat <- p.d.mat
}
# if(!is.null(t.data)){
# for (i in 1:ncol(t.data)) {
# t.data[, i] <- (t.data[, i] - min(t.data[, i]))/(max(t.data[, i])-min(t.data[, i]))
# }
# }
#### Compute the B-splines of the original trait variables (t.data) to get bs.traits
if(!is.null(t.data)){
bs.traits <- matrix(NA, nrow(t.data), (ncol(t.data) * d.f))
for (j in seq(ncol(t.data))) {
for (i in seq(d.f)) {
bs.traits[,(j - 1) * d.f + i] <- splines2::bSpline(t.data[,j], df=d.f, degree=degree, intercept = TRUE)[,i]
}
}
bs.traits <- data.frame(bs.traits)
## Assign names to bs.traits
for (i in 1:(ncol(bs.traits)/d.f)) {
for (j in 1:d.f) {
names(bs.traits)[(i - 1) * d.f + j] <- paste(names(t.data)[i], j, sep = "")
}
}
bs.traits <- `rownames<-`(bs.traits, rownames(t.data))
}
## Compute the differences on the values transformed using b-splines (bs.traits) using SD, to get bs.traits.diff. Simultaneously compute Phylogenetic_distance and encounter rate
order <- 1:nrow(s.data) ## Possible joint occupancy orders
sn <- dim(s.data)[1] ## Total number of species
N <- dim(s.data)[2] ## Total number of sites
ncom <- choose(sn,order.jo) ## Total number of the combinations of "order.jo" species chosen from sn
if(ncom > n){ ## Use MCMC to sample n species combinations if the total combinations > the chosen sample size, n.
jo <- rep(NA, n)
if(!is.null(t.data)){
bs.traits.diff <- matrix(NA, nrow = n, ncol = ncol(bs.traits))
}
erate <- rep(NA, n)
if(!is.null(p.d.mat)){
Phylogenetic_distance <- rep(NA, n)
}
for (j in 1:n) {
# repeat{
sam <- sample(1:sn, order.jo, replace = FALSE)
# if(msco::j.occ(s.data[sam,], order = order.jo)$jo.val>0){
# break
# }}
if(!is.null(t.data)){
bs.traits.diff[j,] <- apply(bs.traits[sam,], 2, stats::sd)
}
#### jo values for chosen combination of species
jo[j] <- (msco::j.occ(s.data[sam,], order = order.jo)$jo.val)
if(metric=="raw"){
jo[j] <- jo[j]
}else if(metric=="Simpson_eqn"){
jo[j] <- jo[j]/min(rowSums(s.data[sam,]))
}else if(metric=="Sorensen_eqn"){
jo[j] <- jo[j]/mean(rowSums(s.data[sam,]))
}
## Phylogenetic_distance
if(!is.null(p.d.mat)){
Phylogenetic_distance[j] <- mean(p.d.mat[t(utils::combn(sort(sam), 2))])
}
## Encounter rate
nsam <- length(sam)
er <- rep(NA, nsam)
for (i in 1:nsam) {
er[i] <- rowSums(s.data[sam[i],])
}
erate[j] <- (prod(er))/(N^nsam)
}
}else{ ## Otherwise use the combinations as they are without sampling n of them.
jo <- rep(NA, ncom)
if(!is.null(t.data)){
bs.traits.diff <- matrix(NA, nrow = ncom, ncol = ncol(bs.traits))
}
erate <- rep(NA, ncom)
if(!is.null(p.d.mat)){
Phylogenetic_distance <- rep(NA, ncom)
}
com <- utils::combn(sn, order.jo)
for (j in 1:ncom) {
if(!is.null(t.data)){
bs.traits.diff[j,] <- apply(bs.traits[com[,j],], 2, stats::sd)
}
#### jo values for chosen combination of species
if(metric=="raw"){
jo[j] <- (msco::j.occ(s.data[com[,j],], order = order.jo)$jo.val)
}else if(metric=="Simpson_eqn"){
jo[j] <- (msco::j.occ(s.data[com[,j],], order = order.jo)$jo.val)/min(rowSums(s.data[com[,j],]))
}else if(metric=="Sorensen_eqn"){
jo[j] <- (msco::j.occ(s.data[com[,j],], order = order.jo)$jo.val)/mean(rowSums(s.data[com[,j],]))
}
## Phylogenetic_distance
if(!is.null(p.d.mat)){
Phylogenetic_distance[j] <- mean(p.d.mat[t(utils::combn(sort(com[,j]), 2))])
}
## Encounter rate
nsam <- length(com[,j])
er <- rep(NA, nsam)
for (i in 1:nsam) {
er[i] <- rowSums(s.data[com[,j][i],])
}
erate[j] <- (prod(er))/(N^nsam)
}
}
if(ncom < n){
n <- ncom
}else{
n <- n
}
if(metric=="raw_prop"){
jo <- jo/N
}
if((metric %in% c("raw", "raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE){
stop("Wrong option for the joint occupancy metric provided. It must either be 'raw', 'raw_prop', 'Simpson_eqn', or 'Sorensen_eqn'.")
}
## Rescale Phylogenetic_distance to be in [0,1]
if(!is.null(p.d.mat)){
Phylogenetic_distance<- (Phylogenetic_distance - min(Phylogenetic_distance))/(max(Phylogenetic_distance)-min(Phylogenetic_distance))
}
## Assign bs.traits.diff (trait differences of B-splines of t.data) column names
if(!is.null(t.data)){
bs.traits.diff <- `colnames<-`(bs.traits.diff, colnames(bs.traits))
bs.traits.diff <- data.frame(bs.traits.diff)
}
## B-splines of Phylogenetic_distance & erate
##bs.Phylogenetic_distance
if(!is.null(p.d.mat)){
bs.Phylogenetic_distance <- matrix(NA, nrow=n, ncol=d.f)
for (i in seq(d.f)) {
bs.Phylogenetic_distance[,i] <- splines2::bSpline(Phylogenetic_distance, df=d.f, degree=degree, intercept = TRUE)[,i]
}
bs.Phylogenetic_distance <- data.frame(bs.Phylogenetic_distance)
}
## bs.erate
bs.erate <- matrix(NA, nrow=length(erate), ncol=d.f)
for (i in 1:d.f) {
bs.erate[,i] <- splines2::bSpline(erate, df=d.f, degree=degree, intercept = TRUE)[,i]
}
bs.erate <- data.frame(bs.erate)
## Assign names to bs.erate & Phylogenetic_distance
for (j in 1:d.f) {
names(bs.erate)[j] <- paste("Encounter_rate", j, sep = "")
if(!is.null(p.d.mat)){
names(bs.Phylogenetic_distance)[j] <- paste("Phylogenetic_distance", j, sep = "")
}
}
## Rescale Phylogenetic_distance to be in [0,1]
erate <- (erate - min(erate))/(max(erate)-min(erate))
### Transform the trait variables (t.data) to fill the gaps in the data for smooth plotting using seq
ff <- c()
tt <- c()
if(ncom > n){
myn <- n
}else{
myn <- ncom
}
if(!is.null(t.data)){
t.data.trans <- matrix(NA, nrow = myn, ncol = ncol(t.data))
for (j in 1:ncol(t.data)) {
t.data.trans[,j] <- seq(from = range(t.data[,j])[1], to = range(t.data[,j])[2], length.out = myn)
}
t.data.trans <- `names<-`(data.frame(t.data.trans), names(t.data))
#### Compute the B-splines of the transformed trait variables (t.data.trans) to get bs.traits.trans
bs.traits.trans <- matrix(NA, nrow(t.data.trans), (ncol(t.data.trans) * d.f))
for (j in 1:ncol(t.data.trans)) {
for (i in 1:d.f) {
bs.traits.trans[,(j - 1) * d.f + i] <- splines2::bSpline(t.data.trans[,j], df=d.f, degree=degree, intercept = TRUE)[,i]
}
}
bs.traits.trans <- data.frame(bs.traits.trans)
## Assign names to bs.traits.trans
for (i in 1:(ncol(bs.traits.trans)/d.f)) {
for (j in 1:d.f) {
names(bs.traits.trans)[(i - 1) * d.f + j] <- paste(names(t.data.trans)[i], j, sep = "")
}
}
}
### Transform the Phylogenetic_distance & erate variables to fill the gaps in the data for smooth plotting using seq
if(!is.null(p.d.mat)){
Phylogenetic_distance.trans <- seq(from = range(Phylogenetic_distance)[1], to = range(Phylogenetic_distance)[2], length.out = myn)
}
erate.trans <- seq(from = range(erate)[1], to = range(erate)[2], length.out = myn)
### Compute the B-splines of the transformed Phylogenetic_distance & erate variables (Phylogenetic_distance.trans & erate.trans) to get bs.Phylogenetic_distance.trans & bs.erate.trans
##Phylogenetic_distance
if(!is.null(p.d.mat)){
bs.Phylogenetic_distance.trans <- matrix(NA, nrow=myn, ncol=d.f)
for (i in 1:d.f) {
bs.Phylogenetic_distance.trans[,i] <- splines2::bSpline(Phylogenetic_distance.trans, df=d.f, degree=degree, intercept = TRUE)[,i]
}
bs.Phylogenetic_distance.trans <- data.frame(bs.Phylogenetic_distance.trans)
}
##erate
bs.erate.trans <- matrix(NA, nrow=myn, ncol=d.f)
for (i in 1:d.f) {
bs.erate.trans[,i] <- splines2::bSpline(erate.trans, df=d.f, degree=degree, intercept = TRUE)[,i]
}
bs.erate.trans <- data.frame(bs.erate.trans)
## Assign names to bs.erate.trans and bs.Phylogenetic_distance.trans
for (j in 1:d.f) {
names(bs.erate.trans)[j] <- paste("Encounter_rate", j, sep = "")
if(!is.null(p.d.mat)){
names(bs.Phylogenetic_distance.trans)[j] <- paste("Phylogenetic_distance", j, sep = "")
}
}
## Transformed values of all variables (trans.variables) and their B-splines (bs.variables.trans)
if(!is.null(t.data) & is.null(p.d.mat)){
bs.variables.trans <- cbind(bs.traits.trans, bs.erate.trans)
trans.variables <- cbind(t.data.trans, erate.trans)
trans.variables <- `names<-`(as.data.frame(trans.variables), c(names(t.data.trans), "Encounter_rate"))
}else if(!is.null(p.d.mat) & is.null(t.data)){
bs.variables.trans <- cbind(bs.Phylogenetic_distance.trans, bs.erate.trans)
trans.variables <- cbind(Phylogenetic_distance.trans, erate.trans)
trans.variables <- `names<-`(as.data.frame(trans.variables), c("Phylogenetic_distance", "Encounter_rate"))
}else if(!is.null(t.data) & !is.null(p.d.mat)){
bs.variables.trans <- cbind(bs.traits.trans, bs.Phylogenetic_distance.trans, bs.erate.trans)
trans.variables <- cbind(t.data.trans, Phylogenetic_distance.trans, erate.trans)
trans.variables <- `names<-`(as.data.frame(trans.variables), c(names(t.data.trans), "Phylogenetic_distance", "Encounter_rate"))
}else{
bs.variables.trans <- bs.erate.trans
trans.variables <- erate.trans
trans.variables <- `names<-`(as.data.frame(trans.variables), "Encounter_rate")
}
#### Plot to see if the correct B-spline plots are output
if(b.plots==TRUE){
cols <- rep(c("red","blue","black","green"), 8*d.f)
# if(bsplines=="single"){
grDevices::pdf(file = paste0(system.file("ms", package = "msco"), "/B-splines.predictor.pdf"), height = 5, width = 5)
plot(x=trans.variables[,1], y=bs.variables.trans[,(1+((1-1)*d.f))], type = "l", lty=1, lwd=2, col=cols[1], ylim=c(0,max(bs.variables.trans[,(1+((1-1)*d.f))])),
xlab = "Trait value", ylab = "B-splines", main = "Trait variable")
for(i in 2:d.f){
graphics::lines(trans.variables[,1], bs.variables.trans[,i], col=cols[i], lwd=2, lty = i)
}
if(!is.null(t.data)){
for (i in 1:d.f) {
graphics::points(t.data[,1], bs.traits[,i], col=cols[i], pch=match(cols[i], cols))
}
}else if(is.null(t.data) & !is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, bs.Phylogenetic_distance[,i], col=cols[i], pch=match(cols[i], cols))
}else if(is.null(t.data) & is.null(p.d.mat)){
graphics::points(erate, bs.erate[,i], col=cols[i], pch=match(cols[i], cols))
}
graphics::text(0.1, 0.95, expression(paste(B["0,4"])), font=2)
graphics::text(0.35, 0.52, expression(paste(B["1,4"])), font=2)
graphics::text(0.7, 0.52, expression(paste(B["2,4"])), font=2)
graphics::text(0.9, 0.95, expression(paste(B["3,4"])), font=2)
grDevices::dev.off()
print(noquote("Check msco's 'ms' folder in your R version's directory for a 'B-splines.predictor.pdf' file."))
# }
# else{
# grDevices::pdf(file = paste0(system.file("ms", package = "msco"), "/B-splines.curves_all.predictors.pdf"), height = 8.27, width = 6)
# graphics::par(mar=c(4,4,2,0.5)+.1)
# graphics::par(mfcol=c(ceiling(((ncol(t.data)+2)/2)), 2))
#
# for (v.index in 1:ncol(trans.variables)) {
# plot(x=trans.variables[,v.index], y=bs.variables.trans[,(1+((v.index-1)*d.f))], type = "l", lty=1, lwd=2, col=cols[1], ylim=c(0,max(bs.variables.trans[,(1+((v.index-1)*d.f))])),
# xlab = "Trait value", ylab = "B-splines", main = paste(names(trans.variables)[v.index]))
#
# for(i in (((v.index-1)*d.f)+2):(((v.index-1)*d.f)+d.f)){
# graphics::lines(trans.variables[,v.index], bs.variables.trans[,i], col=cols[i], lwd=2, lty = i)
# }
# if(v.index < ncol(t.data) | v.index==ncol(t.data)){
# for (i in (1+((v.index-1)*d.f)):(((v.index-1)*d.f)+d.f)) {
# graphics::points(t.data[,v.index], bs.traits[,i], col=cols[i], pch=match(cols[i], cols))
# }
# }else if(v.index==(ncol(t.data)+1)){
# for (i in 1:d.f) {
# graphics::points(Phylogenetic_distance, bs.Phylogenetic_distance[,i], col=cols[i], pch=match(cols[i], cols))
# }
# }else if(v.index==(ncol(t.data)+2)){
# for (i in 1:d.f) {
# graphics::points(erate, bs.erate[,i], col=cols[i], pch=match(cols[i], cols))
# }
# }
# graphics::text(0.13, 0.9, expression(paste(B["0,4"])), font=2)
# graphics::text(0.35, 0.55, expression(paste(B["1,4"])), font=2)
# graphics::text(0.7, 0.55, expression(paste(B["2,4"])), font=2)
# graphics::text(0.87, 0.9, expression(paste(B["3,4"])), font=2)
# }
# grDevices::dev.off()
# print(noquote("Check msco's 'ms' folder in your R version's directory for a 'B-splines.curves_all.predictors.pdf' file."))
# }
}
## Confirm if the plot of the sum of the B-splines is constant at y=1
# plot(t.data[,1], rowSums(bs.traits[, seq(1,ncol(bs.traits),d.f)[1]:seq(d.f,ncol(bs.traits),d.f)[1]]), col=cols[1])
# for (i in 2:((ncol(bs.traits))/d.f)) {
# points(t.data[,i], rowSums(bs.traits[, seq(1,ncol(bs.traits),d.f)[i]:seq(d.f,ncol(bs.traits),d.f)[i]]), col=cols[i])
# }
######################################################################################################################
############################### END (for basis functions plots) ######################################################
######################################################################################################################
############################### B-spline regression (start) ##########################################################
######################################################################################################################
## Combine bs.traits.diff, bs.Phylogenetic_distance (b-splines of Phylogenetic_distance) and bs.erate (b-splines of erate)
if(!is.null(t.data) & is.null(p.d.mat)){
bs.variables.diff <- cbind(bs.traits.diff, bs.erate)
}else if(!is.null(p.d.mat) & is.null(t.data)){
bs.variables.diff <- cbind(bs.Phylogenetic_distance, bs.erate)
}else if(!is.null(t.data) & !is.null(p.d.mat)){
bs.variables.diff <- cbind(bs.traits.diff, bs.Phylogenetic_distance, bs.erate)
}else{
bs.variables.diff <- bs.erate
}
## Perform regression between jo and bs.variables.diff to get the regression coefficients
bs.variables.diff <- data.frame(bs.variables.diff)
if((metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))==TRUE){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasibinomial(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="quasipoisson"){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasipoisson(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="nb"){
model <- suppressWarnings(MASS::glm.nb(jo ~ ., link = log, data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & (gbsm.model %in% c("quasipoisson", "nb"))!=TRUE){
stop("Wrong 'gbsm.model' used for 'raw' version of joint occupancy. It must either be 'quasipoisson' or 'nb'.")
}
## Remove perfectly collinear variables and perform the regression again using the new data
if(length(which(is.na(model$coefficients)==TRUE))!=0){
bs.variables.diff <- bs.variables.diff[,-which(is.na(model$coefficients[-1])==TRUE)]
bs.variables.diff <- data.frame(bs.variables.diff)
# start <- start[-which(is.na(model1$coefficients)==TRUE)]
if((metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))==TRUE){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasibinomial(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="quasipoisson"){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasipoisson(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="nb"){
model <- suppressWarnings(MASS::glm.nb(jo ~ ., link = log, data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & (gbsm.model %in% c("quasipoisson", "nb"))!=TRUE){
stop("Wrong 'gbsm.model' used for 'raw' version of joint occupancy. It must either be 'quasipoisson' or 'nb'.")
}
}
Original.VIFs <- car::vif(model)
## Remove variables with VIF>max.vif and perform the regression again using the new data
if(length(model$coefficients)<2){
stop("Cannot compute the VIF of the model because the model contains fewer than 2 terms. Consider using a different dataset, or increase your 'max.vif' value.")
}else if(length(model$coefficients)>2){
if(length(which(car::vif(model)>=max.vif))!=0){
bs.variables.diff <- bs.variables.diff[,names(trunc(car::vif(model)[-which(car::vif(model)>=max.vif)]))]
bs.variables.diff <- `names<-`(data.frame(bs.variables.diff), names(trunc(car::vif(model)[-which(car::vif(model)>=max.vif)])))
if(ncol(bs.variables.diff)==0){
stop("No covariates for the model. Consider increasing the 'max.vif' value to avoid all covariates being removed, or use a different dataset of covariates.")
}else if(ncol(bs.variables.diff)>0){
if((metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))==TRUE){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasibinomial(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="quasipoisson"){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasipoisson(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="nb"){
model <- suppressWarnings(MASS::glm.nb(jo ~ ., link = log, data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & (gbsm.model %in% c("quasipoisson", "nb"))!=TRUE){
stop("Wrong 'gbsm.model' used for 'raw' version of joint occupancy. It must either be 'quasipoisson' or 'nb'.")
}
}
}
}
if(length(model$coefficients)>2){
Intermediate.VIFs <- car::vif(model)
}else{
Intermediate.VIFs <- print("Intermediate.VIFs Not computed, since the model has fewer than 2 items")
}
## Remove variables with VIF>max.vif2 and perform the regression again using the new data
if(length(model$coefficients)<2){
stop("Cannot compute the VIF of the model because the model contains fewer than 2 terms. Consider using a different dataset, or increase your 'max.vif2' value.")
}else if(length(model$coefficients)>2){
if(length(which(car::vif(model)>=max.vif2))!=0){
bs.variables.diff <- bs.variables.diff[,names(trunc(car::vif(model)[-which(car::vif(model)>=max.vif2)]))]
bs.variables.diff <- data.frame(bs.variables.diff)
if(ncol(bs.variables.diff)==0){
stop("No covariates for the model. Consider increasing the 'max.vif2' value to avoid all covariates being removed, or use a different dataset of covariates.")
}else if(ncol(bs.variables.diff)>0){
if((metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))==TRUE){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasibinomial(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="quasipoisson"){
model <- suppressWarnings(glm2::glm2(jo ~ ., family=stats::quasipoisson(link="log"), data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & gbsm.model=="nb"){
model <- suppressWarnings(MASS::glm.nb(jo ~ ., link = log, data = bs.variables.diff,
start = seq(start.range[1], start.range[2], length.out=(ncol(bs.variables.diff))+1)))
}else if(metric=="raw" & (metric %in% c("raw_prop", "Simpson_eqn", "Sorensen_eqn"))!=TRUE & (gbsm.model %in% c("quasipoisson", "nb"))!=TRUE){
stop("Wrong 'gbsm.model' used for 'raw' version of joint occupancy. It must either be 'quasipoisson' or 'nb'.")
}
}
}
}
if(length(model$coefficients)>2){
Final.VIFs <- car::vif(model)
}else{
Final.VIFs <- print("Final.VIFs Not computed, since the model has fewer than 2 items")
}
mysum <- summary(model)
##### Variance explained
# pred.jo <- stats::predict(model, newdata = bs.variables.diff, type = "response", se = TRUE)
pred.jo <- suppressWarnings(stats::predict.glm(model, newdata = bs.variables.diff, type = "response"))
pred.jo <- as.numeric(pred.jo)
var.expd2 <- (stats::cor(jo, pred.jo))^2
if(scat.plot==TRUE){
plot(jo, pred.jo, xlab="Joint occupancy", ylab="Predicted J. occ")
}
## Obtain the regression coefficients excluding the intercept
coeff <- model$coefficients[-1]
intercept <- model$coefficients[1]
#####################################################################
############# Weighted sum of responses ############################
#####################################################################
########## traits (t.data)
if(!is.null(t.data)){
bs.traits <- `names<-`(data.frame(as.matrix(bs.traits[, which(names(bs.traits) %in% names(coeff))],
nrow=nrow(bs.traits))), names(bs.traits)[which(names(bs.traits) %in% names(coeff))])
coeff.traits <- coeff[1:dim(bs.traits)[2]]
if(ncol(bs.traits)>0){
J_preds.traits <- matrix(NA, nrow=nrow(bs.traits), ncol=ncol(bs.traits))
for (i in 1:ncol(bs.traits)) {
J_preds.traits[,i] <- coeff.traits[i]*bs.traits[,i] + intercept/(length(coeff))
}
J_preds.traits <- `names<-`(data.frame(J_preds.traits), names(bs.traits))
# Sum columns per variable (from J_preds.traits) to get "J_preds.traits.fin"
names(J_preds.traits) <- gsub("[[:digit:]]", "", names(J_preds.traits))
J_preds.traits.fin <- t(rowsum(t(J_preds.traits), group = colnames(J_preds.traits), na.rm = T, reorder=FALSE))
}else if(ncol(bs.traits)==0){
J_preds.traits.fin <- NULL
}
}
########## Phylogenetic_distance
if(!is.null(p.d.mat)){
bs.Phylogenetic_distance <- `names<-`(data.frame(as.matrix(bs.Phylogenetic_distance[, which(names(bs.Phylogenetic_distance) %in% names(coeff))],
nrow=nrow(bs.Phylogenetic_distance))), names(bs.Phylogenetic_distance)[which(names(bs.Phylogenetic_distance) %in% names(coeff))])
if(!is.null(t.data)){
coeff.p.d <- coeff[(dim(bs.traits)[2]+1):(dim(bs.traits)[2]+ncol(bs.Phylogenetic_distance))]
}else if(is.null(t.data)){
coeff.p.d <- coeff[(seq(ncol(bs.Phylogenetic_distance)))]
}
if(ncol(bs.Phylogenetic_distance)>0){
J_preds.p.d <- matrix(NA, nrow=nrow(bs.Phylogenetic_distance), ncol=ncol(bs.Phylogenetic_distance))
for (i in 1:ncol(bs.Phylogenetic_distance)) {
J_preds.p.d[,i] <- coeff.p.d[i]*bs.Phylogenetic_distance[,i] + intercept/(length(coeff))
}
J_preds.p.d <- `names<-`(data.frame(J_preds.p.d), names(bs.Phylogenetic_distance))
# Sum columns per variable (from J_preds.p.d) to get "J_preds.p.d.fin"
names(J_preds.p.d) <- gsub("[[:digit:]]", "", names(J_preds.p.d))
J_preds.p.d.fin <- t(rowsum(t(J_preds.p.d), group = colnames(J_preds.p.d), na.rm = TRUE, reorder=FALSE))
}else if(ncol(bs.Phylogenetic_distance)==0){
J_preds.p.d.fin <- NULL
}
}
########## Encounter_rate
bs.erate <- `names<-`(data.frame(as.matrix(bs.erate[, which(names(bs.erate) %in% names(coeff))],
nrow=nrow(bs.erate))), names(bs.erate)[which(names(bs.erate) %in% names(coeff))])
if(!is.null(t.data) & !is.null(p.d.mat)){
coeff.er <- coeff[(dim(bs.traits)[2]+ncol(bs.Phylogenetic_distance)+1):(dim(bs.variables.diff)[2])]
}else if(!is.null(t.data) & is.null(p.d.mat)){
coeff.er <- coeff[(dim(bs.traits)[2]+1):(dim(bs.variables.diff)[2])]
}else if(is.null(t.data) & !is.null(p.d.mat)){
coeff.er <- coeff[(ncol(bs.Phylogenetic_distance)+1):(dim(bs.variables.diff)[2])]
}else if(is.null(t.data) & is.null(p.d.mat)){
coeff.er <- coeff[seq(dim(bs.variables.diff)[2])]
}
if(ncol(bs.erate)>0){
J_preds.er <- matrix(NA, nrow=nrow(bs.erate), ncol=ncol(bs.erate))
for (i in 1:ncol(bs.erate)) {
J_preds.er[,i] <- coeff.er[i]*bs.erate[,i] + intercept/(length(coeff))
}
J_preds.er <- `names<-`(data.frame(J_preds.er), names(bs.erate))
# Sum columns per variable (from J_preds.er) to get "J_preds.er.fin"
names(J_preds.er) <- gsub("[[:digit:]]", "", names(J_preds.er))
J_preds.er.fin <- t(rowsum(t(J_preds.er), group = colnames(J_preds.er), na.rm = TRUE, reorder=FALSE))
}else if(ncol(bs.erate)==0){
J_preds.er.fin <- NULL
}
#############################################################################
############# Weighted sum of seq-transformed responses #####################
#############################################################################
##Product of coefficients with variables
if(!is.null(t.data) & is.null(p.d.mat)){
coeff.variables <- c(coeff.traits, coeff.er)
}else if(!is.null(p.d.mat) & is.null(t.data)){
coeff.variables <- c(coeff.p.d, coeff.er)
}else if(!is.null(t.data) & !is.null(p.d.mat)){
coeff.variables <- c(coeff.traits, coeff.p.d, coeff.er)
}else{
coeff.variables <- coeff.er
}
bs.variables.trans <- `names<-`(data.frame(as.matrix(bs.variables.trans[, which(names(bs.variables.trans) %in% names(coeff))],
nrow=nrow(bs.variables.trans))), names(bs.variables.trans)[which(names(bs.variables.trans) %in% names(coeff))])
if(ncol(bs.variables.trans)>0){
J_preds.trans <- matrix(NA, nrow=nrow(bs.variables.trans), ncol=ncol(bs.variables.trans))
for (i in 1:ncol(bs.variables.trans)) {
J_preds.trans[,i] <- coeff.variables[i]*bs.variables.trans[,i] + intercept/(dim(bs.variables.diff)[2])
}
J_preds.trans <- `names<-`(data.frame(J_preds.trans), names(bs.variables.trans))
## Sum columns per variable (from J_preds.trans) to get "J_preds.trans.fin"
names(J_preds.trans) <- gsub("[[:digit:]]", "", names(J_preds.trans))
J_preds.trans.fin <- t(rowsum(t(J_preds.trans), group = colnames(J_preds.trans), na.rm = TRUE, reorder=FALSE))
}else if(ncol(bs.variables.trans)==0){
J_preds.trans.fin <- NULL
}
trans.variables <- `names<-`(data.frame(as.matrix(trans.variables[, which(names(trans.variables) %in% unique(gsub("[[:digit:]]", "", names(bs.variables.trans))))],
nrow=nrow(trans.variables))), names(trans.variables)[which(names(trans.variables) %in% unique(gsub("[[:digit:]]", "", names(bs.variables.trans))))])
if(!is.null(t.data)){
t.data <- `names<-`(data.frame(as.matrix(t.data[, which(names(t.data) %in% unique(gsub("[[:digit:]]", "", names(bs.variables.trans))))],
nrow=nrow(t.data))), names(t.data)[which(names(t.data) %in% unique(gsub("[[:digit:]]", "", names(bs.variables.trans))))])
}
####### Plots
if(response.curves==TRUE){
cols <- c("red","blue","black","green", "orange", "brown", "purple")
limits <- range(J_preds.trans.fin)
llim <- limits[1]
ulim <- limits[2]
if(ylabel==TRUE){
if(leg==0){
plot(x=trans.variables[,1], y=J_preds.trans.fin[,1], type = "l", lty=1, lwd=1.5, col=cols[1], ylim=c(llim, ulim),
xlab = "Predictor value", ylab = "Wtd pred. value", main = noquote(paste("Order",order.jo)), cex=0.8, pch=1)
if(ncol(trans.variables)>=2){
for(i in 2:ncol(trans.variables)){
graphics::lines(trans.variables[,i], J_preds.trans.fin[,i], col=cols[i], lwd=1.5, lty=i, cex=0.8, pch=i)
}
}
if(!is.null(t.data)){
for(i in 1:ncol(t.data)){
graphics::points(t.data[,i], J_preds.traits.fin[,i], col=cols[i], lwd=1, lty=i, cex=0.7, pch=i)
}
}
if(!is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, J_preds.p.d.fin, col=cols[(length(trans.variables)-1)], lwd=1, pch=10, cex=0.6)
}
graphics::points(erate, J_preds.er.fin, col=cols[(length(trans.variables))], lwd=1, pch=18, cex=0.7)
}else if(leg==1){
plot(x=trans.variables[,1], y=J_preds.trans.fin[,1], type = "l", lty=1, lwd=1.5, col=cols[1], ylim=c(llim, (ulim + 0.2)),
xlab = "Predictor value", ylab = "Wtd pred. value", main = noquote(paste("Order",order.jo)), cex=0.8, pch=1)
if(ncol(trans.variables)>=2){
for(i in 2:ncol(trans.variables)){
graphics::lines(trans.variables[,i], J_preds.trans.fin[,i], col=cols[i], lwd=1.5, lty=i, cex=0.8, pch=i)
}
}
if(!is.null(t.data)){
for(i in 1:ncol(t.data)){
graphics::points(t.data[,i], J_preds.traits.fin[,i], col=cols[i], lwd=1, lty=i, cex=0.7, pch=i)
}
}
if(!is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, J_preds.p.d.fin, col=cols[(length(trans.variables)-1)], lwd=1, pch=10, cex=0.6)
}
graphics::points(erate, J_preds.er.fin, col=cols[(length(trans.variables))], lwd=1, pch=18, cex=0.7)
graphics::legend("top", legend = names(trans.variables), col = cols, lty=1:ncol(trans.variables), lwd=1.5,
pch = 1:(ncol(trans.variables)), bty = "n", pt.cex = 0.8, text.width = 0.25, cex = 0.8, ncol = 2)
}else if(leg==2){
plot(x=trans.variables[,1], y=J_preds.trans.fin[,1], type = "l", lty=1, lwd=1.5, col=cols[1], ylim=c(llim, (ulim + 2)),
xlab = "Predictor value", ylab = "Wtd pred. value", main = noquote(paste("Order",order.jo)), cex=0.8, pch=1)
if(ncol(trans.variables)>=2){
for(i in 2:ncol(trans.variables)){
graphics::lines(trans.variables[,i], J_preds.trans.fin[,i], col=cols[i], lwd=1.5, lty=i, cex=0.8, pch=i)
}
}
if(!is.null(t.data)){
for(i in 1:ncol(t.data)){
graphics::points(t.data[,i], J_preds.traits.fin[,i], col=cols[i], lwd=1, lty=i, cex=0.7, pch=i)
}
}
if(!is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, J_preds.p.d.fin, col=cols[(length(trans.variables)-1)], lwd=1, pch=10, cex=0.6)
}
graphics::points(erate, J_preds.er.fin, col=cols[length(trans.variables)], lwd=1, pch=18, cex=0.7)
graphics::legend("top", legend = names(trans.variables), col = cols, lty=1:ncol(trans.variables), lwd=1.5,
pch = 1:(ncol(trans.variables)), bty = "n", pt.cex = 0.8, text.width = 0.25, cex = 0.8, ncol = 2)
}
}else{
if(leg==0){
plot(x=trans.variables[,1], y=J_preds.trans.fin[,1], type = "l", lty=1, lwd=1.5, col=cols[1], ylim=c(llim, ulim),
xlab = "Predictor value", ylab = " ", main = noquote(paste("Order",order.jo)), cex=0.8, pch=1)
if(ncol(trans.variables)>=2){
for(i in 2:ncol(trans.variables)){
graphics::lines(trans.variables[,i], J_preds.trans.fin[,i], col=cols[i], lwd=1.5, lty=i, cex=0.8, pch=i)
}
}
if(!is.null(t.data)){
for(i in 1:ncol(t.data)){
graphics::points(t.data[,i], J_preds.traits.fin[,i], col=cols[i], lwd=1, lty=i, cex=0.7, pch=i)
}
}
if(!is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, J_preds.p.d.fin, col=cols[(length(trans.variables)-1)], lwd=1, pch=10, cex=0.6)
}
graphics::points(erate, J_preds.er.fin, col=cols[(length(trans.variables))], lwd=1, pch=18, cex=0.7)
}else if(leg==1){
plot(x=trans.variables[,1], y=J_preds.trans.fin[,1], type = "l", lty=1, lwd=1.5, col=cols[1], ylim=c(llim, (ulim + 0.2)),
xlab = "Predictor value", ylab = " ", main = noquote(paste("Order",order.jo)), cex=0.8, pch=1)
if(ncol(trans.variables)>=2){
for(i in 2:ncol(trans.variables)){
graphics::lines(trans.variables[,i], J_preds.trans.fin[,i], col=cols[i], lwd=1.5, lty=i, cex=0.8, pch=i)
}
}
if(!is.null(t.data)){
for(i in 1:ncol(t.data)){
graphics::points(t.data[,i], J_preds.traits.fin[,i], col=cols[i], lwd=1, lty=i, cex=0.7, pch=i)
}
}
if(!is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, J_preds.p.d.fin, col=cols[(length(trans.variables)-1)], lwd=1, pch=10, cex=0.6)
}
graphics::points(erate, J_preds.er.fin, col=cols[(length(trans.variables))], lwd=1, pch=18, cex=0.7)
graphics::legend("top", legend = names(trans.variables), col = cols, lty=1:ncol(trans.variables), lwd=1.5,
pch = 1:(ncol(trans.variables)), bty = "n", pt.cex = 0.8, text.width = 0.25, cex = 0.8, ncol = 2)
}else if(leg==2){
plot(x=trans.variables[,1], y=J_preds.trans.fin[,1], type = "l", lty=1, lwd=1.5, col=cols[1], ylim=c(llim, (ulim + 2)),
xlab = "Predictor value", ylab = " ", main = noquote(paste("Order",order.jo)), cex=0.8, pch=1)
if(ncol(trans.variables)>=2){
for(i in 2:ncol(trans.variables)){
graphics::lines(trans.variables[,i], J_preds.trans.fin[,i], col=cols[i], lwd=1.5, lty=i, cex=0.8, pch=i)
}
}
if(!is.null(t.data)){
for(i in 1:ncol(t.data)){
graphics::points(t.data[,i], J_preds.traits.fin[,i], col=cols[i], lwd=1, lty=i, cex=0.7, pch=i)
}
}
if(!is.null(p.d.mat)){
graphics::points(Phylogenetic_distance, J_preds.p.d.fin, col=cols[(length(trans.variables)-1)], lwd=1, pch=10, cex=0.6)
}
graphics::points(erate, J_preds.er.fin, col=cols[(length(trans.variables))], lwd=1, pch=18, cex=0.7)
graphics::legend("top", legend = names(trans.variables), col = cols, lty=1:ncol(trans.variables), lwd=1.5,
pch = 1:(ncol(trans.variables)), bty = "n", pt.cex = 0.8, text.width = 0.25, cex = 0.8, ncol = 2)
}
}
}
gbs <- list()
gbs$Predictors <- trans.variables
gbs$Responses <- as.data.frame(J_preds.trans.fin)
gbs$order.jo <- order.jo
gbs$coeff <- coeff
gbs$glm_obj <- model
gbs$j.occs <- jo
gbs$pred.j.occs <- pred.jo
gbs$bs_pred <- bs.variables.diff
gbs$start.range <- start.range
gbs$var.expld <- var.expd2
gbs$Original.VIFs <- Original.VIFs
gbs$Intermediate.VIFs <- Intermediate.VIFs
gbs$Final.VIFs <- Final.VIFs
gbs$summary <- mysum
class(gbs) <- "gbsm"
return(gbs)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.