#' Make a waffle chart.
#'
#' Waffle chart is a pie chart that visually represents abundances with the number of squares.
#'
#' The waffle chart consists of squares plotted on a rectangular lattice according to a design
#' matrix that is constructed automatically from a vector of abundances or can be directly provided.
#'
#' The \code{waffle} function accepts a vector of abundances and constructs the design matrix,
#' which is then parsed to the \code{waffle.mat} function. By default, the design matrix is by row
#' with sequential numbers according to the vector of abundances \code{x}. This means that if
#' the \code{x=c(3,5)}, the matrix will be filled with three \code{1} and five \code{2}, all other
#' cells of the matrix are set as unknown values \code{NA}. By default, 10 rows and 10 columns are
#' used so that one square represents 1\% of the total. This might have an undesirable side-effect
#' If the sum of values in \code{x} is significantly smaller than 100 as a relatively large amount
#' of empty space will still be allocated. This can be easily corrected by providing a reasonable
#' number of rows and columns.
#'
#' The function \code{waffle.mat} accepts a custom-made design matrix and thus allows a better
#' control of colored regions. It is called internally by the \code{waffle} function, which serves
#' as an easy to use interface for the \code{waffle.mat}. For this reason, the \code{waffle.mat}
#' does not checks for the validity of input arguments and does not set a default colors.
#'
#' The assumed and allocated coordinate system is from \code{1} to \code{ncol+1} for x and
#' from \code{1} to \code{ncol+1} for y. Squares are filled from top right corner of this coordinate
#' system.
#'
#' If \code{add=FALSE}, a new window with a fixed aspect ratio x/y=1 is allocated so that
#' plotted rectangles are squares. This might cause the plot margins, and thus the main title,
#' to be quite far away. In this case, plotting the title using \code{text} instead of \code{title}
#' might be a better idea. In this case, the coordinates might be:
#' \code{text(x=(ncol+2)/2, y=nrow+1,...)}
#'
#'
#'
#' @param x a vector of abundances
#' @param mat a design matrix (see details)
#' @param col a vector of colors, must be the same length as the x. If not specified, the "Set1"
#'  palette from the package RColorBrewer is used.
#' @param nrow an amount of rows
#' @param ncol an amount of columns
#' @param border the border color of squares, by default no border is plotted
#' @param adj an amount by which squares are shrinked so they do not touch each other
#' @param byrow whether to fill matrix by rows (default) or columns
#' @param add whether to add to a current plot
#'
#' @seealso \code{\link[waffle]{waffle}} in the \code{waffle} package for a ggplot2 version.
#'
#' @examples
#' waffle(c(50,25,25))
#' waffle(c(25,75), c("darkorchid", "lightgray"))
#' waffle(c(14,8,4), nrow=3)
#'
#' # custom design matrix with a more complex structure
#' cols = RColorBrewer::brewer.pal(3, "Set1")
#' design_mat = matrix(NA, 7,10)
#' design_mat[1,] = 1
#' design_mat[2,1:8] = 1
#' design_mat[4,] = 2
#' design_mat[5,1:4] = 2
#' design_mat[7,1:5] = 3
#' waffle.mat(design_mat, cols)
#'
#' @export
waffle = function(x, col, nrow=10, ncol=10, border=NA, adj=0.1, byrow=TRUE, add=FALSE){
    if(missing(col))
        col = RColorBrewer::brewer.pal(9, "Set1")[seq_along(x)]

    total = sum(x)
    cells = nrow*ncol

    if(total > cells)
        stop("The sum of elements in x must be smaller or equal to the total number of cells")
    if(length(col) < length(x))
        stop("x and col must have the same length")

    # build the design matrix:
    mat = rep(seq_along(x), x)
    mat = c(mat, rep(NA, cells - total))
    mat = matrix(mat, nrow, ncol, byrow=byrow)

    # plot the waffle using the design matrix
    waffle.mat(mat, col=col, border=border, adj=adj, add=add)
    }

#' @rdname waffle
#' @export
waffle.mat = function(x, col, border=NA, adj=0.1, add=FALSE){
    nrow = nrow(x)
    ncol = ncol(x)
    x = as.vector(x)
    pick = !is.na(x)
    x = x[pick]

    xx = matrix(1:ncol, nrow, ncol, byrow=TRUE)
    xx = as.vector(xx)[pick]
    x1 = xx + adj
    x2 = xx + 1 - adj

    yy = matrix(nrow:1, nrow, ncol)
    yy = as.vector(yy)[pick]
    y1 = yy + adj
    y2 = yy + 1 - adj

    if(!add){
        graphics::plot.new()
        graphics::plot.window(xlim=c(1, ncol+1), ylim=c(1, nrow+1), asp=1)
        }
    graphics::rect(x1, y1, x2, y2, col=col[x], border=border)
    }


#' Tidy up a messy data
#'
#' @Description
#'
#' Tidying simulation results is not just a fast process; it's dependent on an
#' assessment about the types of values a data scientist expects from a neat evaluation.
#' The terminology "tidy data" provides a sophisticated data modification
#' and processing platform. Produces a tibble that highlights the summary statistics of the model.
#' It comprises coefficients and p-values between each term in a regression,
#' data linear elastic grouping algorithms, and statistics per-test in functions.
#' It is possible to lose part of the information that is sought in the original item,
#' or to keep more than it is required.
#'
#' @usage
#'
#' broom::tidy
#'
#' tidy(x, confint, ...)
#'
#' @argument
#'
#' @param x tidy may be computed for a virtual element
#'
#' @param confint confidence level
#'
#' @param ... more justifications for tidy
#'
#' @examples
#'
#' #Compute a set of data for each group
#'
#'person_df <- tibble(
#'    states = c("Oregon", "Washington", "California", "Washington", "California", "Oregon", "California", "Oregon", "Washington", "Washington", "Oregon"),
#'    year = c(2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010),
#'    housing = c(782578.25, 202450.29, 352629.20, 2042649.20, 24685.20, 1034.30, 2016285.29, 209425.20, 207854.59, 424501.49, 245580.49),
#'    salary =  c(2452.24, 2745.48, 1855.24, 2757.99, 9718.74, 1987.58, 9784.75, 8174.89, 3578.17, 5871.98, 7589.71)
#'     )
#'
#' # Take a logarithmic fit on a person dataset as an experiment.
#'
#' person_df %>%
#'  lm((housing ~ salary + year), data = .)
#'
#' # Now compare it using tidy(x). By naming your data, making this to be x.
#' # It organizes useful outputs in order to read easily. This is one way to perform a hypothesis test.
#'
#' library(broom)
#'
#' person <- person_df %>%
#'  lm((housing ~ salary + year), data = .)
#'
#' tidy(person)
#'
#'----------------------------------
#'
#' # Another efficient way to tidy your data.
#'
#' person_df %>%
#'  lm((housing ~ salary + year), data = .) %>%
#'  broom::tidy()
#'
#'-------------------------------------
#'
#' # Use confidence interval to determin levels
#'
#' person2 <- function(n) {
#'   person_df %>%
#'     lm(housing ~ salary, data = .) %>%
#'     broom::tidy(conf.int = TRUE)
#'


#Title: Calc_relative_expression
#Auther: Naoto Imamachi
#ver: 1.0.0
#Date: 2015-10-23

###Check_BRIC-seq_dataset###
test_q <- function(x,y){
    q_99 <- as.vector(quantile(x, prob=0.99, na.rm=T))
    q_95 <- as.vector(quantile(x, prob=0.95, na.rm=T))
    q_90 <- as.vector(quantile(x, prob=0.90, na.rm=T))
    q_80 <- as.vector(quantile(x, prob=0.80, na.rm=T))
    q_70 <- as.vector(quantile(x, prob=0.70, na.rm=T))
    q_60 <- as.vector(quantile(x, prob=0.60, na.rm=T))
    q_50 <- as.vector(quantile(x, prob=0.50, na.rm=T))
    q_40 <- as.vector(quantile(x, prob=0.40, na.rm=T))
    q_30 <- as.vector(quantile(x, prob=0.30, na.rm=T))
    q_20 <- as.vector(quantile(x, prob=0.20, na.rm=T))
    q_10 <- as.vector(quantile(x, prob=0.10, na.rm=T))
    q_5 <- as.vector(quantile(x, prob=0.05, na.rm=T))
    q_1 <- as.vector(quantile(x, prob=0.01, na.rm=T))
    vec <- c(q_99,q_95,q_90,q_80,q_70,q_60,q_50,q_40,q_30,q_20,q_10,q_5,q_1)
    factor_label <- c("99%","95%","90%","80%","70%","60%","50%","40%","30%","20%","10%","05%","01%")
    label <- rep(y,13)
    q_table <- data.frame(name=label,q=vec,factor=factor_label)
    return(q_table)
}

BridgeRDatasetChecker <- function(InputFile, group, hour, InforColumn=4, OutputFile="BridgeR_2_Relative_RPKM_distribution"){
    ###Prepare_files###
    time_points <- length(hour)

    input_file <- fread(InputFile, header=T)

    sample_size <- length(group)
    test_data <- NULL #input data for fig
    if(sample_size == 1){
        test_data <- input_file[input_file$T00_1 == 1,]
    }else if(sample_size == 2){
        test_data <- input_file[input_file$T00_1 == 1 & input_file$T00_2 == 1,]
    }else if(sample_size == 3){
        test_data <- input_file[input_file$T00_1 == 1 & input_file$T00_2 == 1 & input_file$T00_3 == 1,]
    }else if(sample_size == 4){
        test_data <- input_file[input_file$T00_1 == 1 & input_file$T00_2 == 1 & input_file$T00_3 == 1 & input_file$T00_4 == 1,]
    }

    ###Boxplot_for_each_sample###
    merge_fig_data <- NULL
    merge_fig_percentile_data <- NULL
    for(a in 1:sample_size){
        ###Information&exp_data column###
        infor_st <- 1 + (a - 1)*(time_points + InforColumn)
        infor_ed <- (InforColumn)*a + (a - 1)*time_points
        exp_st <- infor_ed + 1
        exp_ed <- infor_ed + time_points

        ###Hour_label###
        hour_label <- NULL
        for(x in hour){
            if(x == 0){
                next
            }
            label <- x
            if(x < 10){
                label <- paste("0",x,sep="")
            }
            hour_label <- append(hour_label, paste(label,"hr_",group[a], sep=""))
        }

        ###Prepare_exp_data###
        exp_st <- exp_st + 1
        exp_data <- test_data[,exp_st:exp_ed,with=F] #except time0

        exp_percentile_data <- NULL
        time_points_for_fig <- time_points - 1
        for(x in 1:time_points_for_fig){
            q_data <- test_q(log10(exp_data[[x]]),hour_label[x])
            if(x == 1){
                exp_percentile_data <- q_data
            }else{
                exp_percentile_data <- rbind(exp_percentile_data, q_data)
            }
        }

        exp_data <- t(exp_data) #Inverse
        exp_data <- factor(exp_data)
        exp_data <- as.numeric(as.character(exp_data)) #exp_data for fig_data
        exp_data <- log10(exp_data)

        ###Label_data###
        gene_number <- length(test_data[[1]])
        label_data <- rep(hour_label,gene_number) #label_data for fig_data

        ###Fig_data###
        fig_data <- data.frame(exp=exp_data, label=factor(label_data))
        if(a == 1){
            merge_fig_data <- fig_data
            merge_fig_percentile_data <- exp_percentile_data
        }else{
            merge_fig_data <- rbind(merge_fig_data, fig_data)
            merge_fig_percentile_data <- rbind(merge_fig_percentile_data, exp_percentile_data)
        }

        ###fig_name###
        fig_name <- paste(OutputFile,"_Boxplot_",group[a],".png",sep="")
        fig_width <- 150*(time_points-1)
        png(filename=fig_name,width = fig_width, height = 1200)

        ###fig_plot###
        p <- ggplot()
        p <- p + layer(data=fig_data,
                       mapping=aes(x=label,y=exp),
                       geom="boxplot")
        p <- p + ylim(-2,2)
        plot(p)
        dev.off() #close_fig
        plot.new()

        ###fig_name2###
        fig_name <- paste(OutputFile,"_Density_",group[a],".png",sep="")
        png(filename=fig_name,width = 1300, height = 1000)

        ###fig_plot2###
        p <- ggplot()
        p <- p + layer(data=fig_data,
                       mapping=aes(x=exp,colour=label),
                       geom="line",
                       stat="density",
                       size=1.2)
        p <- p + xlim(-2,2) + ylim(0,7)
        plot(p)
        dev.off() #close_fig
        plot.new()

        ###fig_name3###
        fig_name <- paste(OutputFile,"_Point_",group[a],".png",sep="")
        fig_width <- 120*(time_points-1)
        png(filename=fig_name,width = fig_width, height = 1200)

        ###fig_plot3###
        p <- ggplot()
        p <- p + layer(data=exp_percentile_data,
                       mapping=aes(x=name, y=q, colour=factor(factor)),
                       geom="point",
                       size=5,
                       shape=19)
        p <- p + xlab("") + ylab("Relative RPKM (Time0 = 1)")
        p <- p + ylim(-1.5,1.5)
        plot(p)
        dev.off() #close_fig
        plot.new()

    }

    ###Boxplot_for_all_sample###
    ###fig_name###
    fig_name <- NULL
    for(a in 1:sample_size){
        if(a == 1){
            fig_name <- paste(OutputFile,"_Boxplot_",group[a],sep="")
        }else{
            fig_name <- paste(fig_name,"_",group[a],sep="")
        }
    }
    fig_name <- paste(fig_name,".png",sep="")
    fig_width <- 150*(time_points-1)*sample_size
    png(filename=fig_name,width = fig_width, height = 1200)

    ###fig_plot###
    merge_fig_data$label <- factor(merge_fig_data$label, levels=sort(unique(as.character(merge_fig_data$label))))
    p <- ggplot()
    p <- p + layer(data=merge_fig_data,
                   mapping=aes(x=label,y=exp),
                   geom="boxplot")
    p <- p + ylim(-2,2)
    plot(p)
    dev.off() #close_fig
    plot.new()

    ###Pointplot_for_all_sample###
    ###fig_name###
    fig_name <- NULL
    for(a in 1:sample_size){
        if(a == 1){
            fig_name <- paste(OutputFile,"_Point_",group[a],sep="")
        }else{
            fig_name <- paste(fig_name,"_",group[a],sep="")
        }
    }
    fig_name <- paste(fig_name,".png",sep="")
    fig_width <- 110*(time_points-1)*sample_size
    png(filename=fig_name,width = fig_width, height = 1200)

    ###fig_plot###
    merge_fig_percentile_data$name <- factor(merge_fig_percentile_data$name, levels=sort(unique(as.character(merge_fig_percentile_data$name))))
    p <- ggplot()
    p <- p + layer(data=merge_fig_percentile_data,
                   mapping=aes(x=name, y=q, colour=factor(factor)),
                   geom="point",
                   size=5,
                   shape=19)
    p <- p + xlab("") + ylab("Relative RPKM (Time0 = 1)")
    p <- p + ylim(-1.5,1.5)
    plot(p)
    dev.off() #close_fig
    plot.new()
}


#' @rdname niches
#' @name niches
#' @title Generate scenarios for species niches
#' @param nsp Number of species
#' @param nr Number of resources
#' @param location Location parameter for the niche, see 'details'.
#' @param breadth Niche breadth, see 'details'.
#' @param scale_c Niche height for colonisation, see 'details'.
#' @param scale_e Niche height for extinction, see 'details'.
#' @param r_use Resource use scaling parameter, see 'details
#' @param r_lim Minimum and maximum possible values for each resource dimension; can be a vector
#'		in the case of a single resource, otherwise a matrix with 2 columns and nr rows.
#' @param static Vector, the indices of resources that are static, `NA` if none. Any resources
#'		that are not static are by definition dynamic
#' @param ratio A 2-column matrix; each row is the indices of a pair of resources. The ratio of
#'		the first to the second will define a single niche dimension. If missing, no ratios used.
#' @param ... Additional named niche parameters to override the defaults in `niches_custom()`.
#' @details
#' Scenarios handle the complexity of generating niches for you. For custom niches, there is some
#' in allowable parameter values and dimensions. Details follow.
#'
#' `location`: Required for custom niches; the location of the niche optimum for each
#' species-resource combination.
#' Must be a matrix with one row per species (`nsp`), one column per niche axis (`nr`). For a
#' single niche axis, a vector with one entry per species is also accepted. The location is the
#' mean of the Gaussian colonisation function.
#'
#' `breadth`: Niche breadth, or the standard deviation of the Gaussian colonisation function;
#' larger values indicate species can occur in a wider variety of environments. For a single
#' niche dimension, either a scalar (all species have the same breadth) or a vector of length `nsp`.
#' For multivariate niches, the following are possible:
#'
#'   * A **scalar**: all species have the same breadth in each niche dimension
#'   * A **vector** of length `nsp`: each species has a different breadth, but breadth is the same
#'   	for each niche axis.
#'   * A **vector** of length `nr`: niche breadth varies by axis, but all species have the same
#'   	breadth for each niche axis. If `nr == nsp`, then this option is not possible, instead the
#'   	former applies.
#'   * A **matrix** of `nsp` rows and `nr` columns: each species-resource combo has a unique
#'   	breadth, but all resources are orthogonal. In other words, performance for a given resource
#'   	cannot depend on the concentration of any other resource.
#'   * A **list** of length `nsp`, each element is a square symmetric `nr` by `nr` matrix. Similar
#'   	to the matrix above, but a full variance-covariance matrix is supplied for each species,
#'   	describing the breadth of the niche along each axis but also how the axes covary.
#'
#' For ratio niche dimensions, note that `nr` will be larger than the number of niche dimensions
#' specified in `location` and `breadth`.  Ratio dimensions will always be inserted at the end
#' of the resource matrix, regardless of the position of the original resources, and it is necessary
#' that the `location` and `breadth` parameters reflect this. For example, if the niche dimensions
#' for three resources are the r1:r2 ratio and r3, the `location` parameter should be of length 2,
#' with the first entry being the location for r3, and the second for r1:r2. To avoid confusion,
#' it is recommended (but not required) that users only construct ratio niches from resources that
#' are specified at the end.
#'
#' `scale_c`, `scale_e`: The (relative) height of the Gaussian colonisation function or
#' the constant extinction function, must be a positive real number.
#' Can be supplied as a scalar (all species have the same scale) or a vector of length `nsp`.
#' If missing a default value of 0.5 (for colonisation) or 0.2 (for extinction) will be used.
#'
#' `r_use`: The scale of resource consumption; larger values indicate
#' faster consumption of resources, see [ruf()] for more details. This can be a scalar (all species
#' consume all resources at the same rate relative to niche position), a vector of length `nsp`
#' (species behave differently, but all resources within species are consumed identically),
#' a vector of length `nr` (all species have identical behaviour, but each resource is consumed at
#' a different rate), or a matrix with `nsp` rows and `nr` columns. Note that static resources
#' ignore this parameter.
#' @return A list of niche parameters, suitable for passing on to [species()].
#' @examples
#' niches_uniform(nsp = 4)
#' niches_custom(nsp = 2, nr = 2, location = matrix(c(1,2,3,4), nrow=2))
#' @export
niches_custom = function(nsp, nr, location, breadth = 1, scale_c = 0.5, scale_e = 0.2,
		r_use = 0.05, r_lim = matrix(rep(c(0, 1), each = nr), ncol = 2), static, ratio) {

	val = list()
	val$r_types = rep("normal", nr)
	if(missing(ratio)) {
		nn = nr # number of niche dimensions
		val$r_trans = identity # transform resources into niche dimensions
	}
	else {
		ratio = .check_ratio(ratio, nr)
		nn = nr - nrow(ratio)
		val$r_trans = ratio_transform(ratio)
		val$ratio = ratio
		val$r_types[as.vector(ratio)] = "ratio"
	}

	if(missing(static)) {
		static = integer()
	} else {
		val$r_types[static] = "static"
	}

	if(!is.matrix(location)) {
		if(nn != 1)
			stop("If nr > 1, location must be a matrix")
		location = matrix(location, ncol = 1)
	}

	val$location = lapply(1:nsp, function(i) location[i, ])
	val$breadth = .check_breadth(breadth, nsp, nn)
	val$scale_c = .check_scale(scale_c, nsp)
	val$scale_e = .check_scale(scale_e, nsp)
	val$r_use = .check_r_use(r_use, nsp, nr, static)

	if(!is.matrix(r_lim))
		r_lim = matrix(r_lim, ncol = 2)

	if(nrow(r_lim) != nr)
		stop("r_lim must be a matrix with 1 row per resource and 2 columns")
	val$r_lim = r_lim
	val
}

#' @rdname niches
#' @name niches
#' @export
niches_uniform = function(nsp = 2, nr = 1, r_lim = c(0, 1), ...) {
	if(nr > 1)
		stop("niches_uniform does not yet support multiple resources, use niches_random instead.")

	## for small numbers of species, we create some buffer around the edges
	if(nsp < 6) {
		location = seq(r_lim[1], r_lim[2], length.out = nsp + 2)
		location = location[2:(nsp + 1)]
	} else {
		location = seq(r_lim[1], r_lim[2], length.out = nsp)
	}
	pars = list(...)
	if(! "breadth" %in% names(pars) & nsp > 1)
		pars$breadth = location[2] - location[1]
	pars$nsp = nsp
	pars$nr = nr
	pars$location = location
	pars$r_lim = r_lim
	do.call(niches_custom, pars)
}

#' @rdname niches
#' @name niches
#' @export
niches_random = function(nsp = 2, nr = 1, r_lim = c(0, 1), ratio, ...) {
	if(!is.matrix(r_lim) && length(r_lim == 2))
		r_lim = cbind(rep(r_lim[1], nr), rep(r_lim[2], nr))

	pars = list(...)
	if(missing(ratio)) {
		nn = nr # number of niche dimensions
	}
	else {
		ratio = .check_ratio(ratio, nr)
		nn = nr - nrow(ratio)
		pars$ratio = ratio
	}

	location = do.call(rbind, lapply(1:nsp, function(i) runif(nn, r_lim[, 1], r_lim[, 2])))
	pars$location = location
	pars$r_lim = r_lim
	pars$nsp = nsp
	pars$nr = nr
	if(! "breadth" %in% names(pars)) {
		sd_avg = (r_lim[, 2] - r_lim[, 1]) / nsp
		sd_sd = sd_avg / 4
		if(nn == 1) {
			pars$breadth = rnorm(nsp, sd_avg, sd_sd)
		} else {
			pars$breadth = lapply(1:nsp, function(i) {
				y = matrix(0, nrow = nn, ncol = nn)
				diag(y) = rnorm(nn, sd_avg, sd_sd)
				y
			})
		}
	}
	do.call(niches_custom, pars)
}

#' @rdname dispersal
#' @name dispersal
#' @title Generate scenarios for species' dispersal abilities
#' @param nsp Number of species
#' @param alpha A scalar or a vector, active dispersal ability for each species
#' @param beta A scalar or a vector, passive dispersal ability for each species
#' @param ... Additional named dispersal parameters to override the defaults in
#'		`dispersal_custom()`.
#' @return A list of dispersal parameters
#' @examples
#' dispersal_custom(nsp = 3)
#' @export
dispersal_custom = function(nsp, alpha = 0.05, beta = 0.5) {
	if(length(alpha) == 1)
		alpha = rep(alpha, nsp)
	if(length(beta) == 1)
		beta = rep(beta, nsp)
	if(length(alpha) != nsp)
		stop("length(alpha) must be 1 or the number of species")
	if(length(beta) != nsp)
		stop("length(beta) must be 1 or the number of species")
	list(alpha = alpha, beta = beta)
}

#' @rdname community_scenarios
#' @name community_scenarios
#' @title Generate scenarios for site by species matrices
#' @details community_random will ensure that all sites have at least one species.
#' If many species have low prevalence, it may be that the initial random draw produces
#' many zero-richness sites, in which case one species will be selected at random for
#' each of these sites. This can have the side effect that the prevalences in the end do
#' not match the desired prevalence very closely.
#'
#' community_equilibrium simply places species at all sites where they are expected to be present
#' at equilibrium, in the absence of competition (i.e., the fundamental niche is positive).
#' @param rn A [river_network()]
#' @param mc A [metacommunity()]
#' @param prevalence A vector of length 1 or `length(mc[['species']])`, what proportion of sites
#' should be occupied on average by each species.
#' @param allow_empty_sites Logical, if FALSE then empty sites will be filled with a single species
#' at random; this may result in slight departures from the desired prevalence.
#' @return A site by species matrix, with sites taken from `rc` and species from `mc`
#' @examples
#' Q = rep(1, 4)
#' adj = matrix(0, nrow = 4, ncol = 4)
#' adj[1,2] = adj[2,3] = adj[4,3] = 1
#' rn = river_network(adj, Q)
#' mc = metacommunity()
#' site_by_species(rn) = community_random(rn, mc)
#' plot(rn, variable = "site_by_species")
#' @export
community_random = function(rn, mc, prevalence = 0.25, allow_empty_sites = TRUE) {
	i = nrow(adjacency(rn))
	j = length(mc$species)
	com = do.call(cbind, mapply(function(jj, pr)
		sample(0:1, i, replace = TRUE, prob = c(1-pr, pr)), 1:j, prevalence, SIMPLIFY = FALSE))

	if(all(prevalence < 1/i))
		warning("All species have low prevalence; random communities might not match desired prevalences")
	r0 = which(rowSums(com) == 0)
	if(length(r0) > 0 & !allow_empty_sites) {
		for(k in r0)
			com[k, sample(1:j)] = 1
	}
	return(com)
}

#' @rdname community_scenarios
#' @export
community_equilibrium = function(rn, mc) {
	niches = f_niche(mc, state(rn, "resources"))
	val = (f_niche(mc, state(rn, "resources")) > 0) * 1
	colnames(val) = attr(mc, "sp_names")
	val
}

#' @rdname r_transform
#' @name r_transform
#' @title Transform resources into niche dimensions
#'
#' @keywords internal
ratio_transform = function(ratio) {
	# take the ratio of the designated columns, and append them to the end, dropping the originals
	return(function(x) {
		cbind(x[,-as.vector(ratio)],
			apply(ratio, 1, function(i) x[,i[1]] / x[, i[2]]))
	})
}


#' crossprod
#'
#' Croddproducts.
#'
#' @param x
#' An fmlmat matrix.
#' @param y
#' Either \code{NULL}, or an fmlmat matrix.
#'
#' @return
#' A matrix of the same type as the inputs.
#'
#' @name crossprod
#' @rdname crossprod
NULL

#' @rdname crossprod
#' @export
setMethod("crossprod", signature(x="fmlmat", y="ANY"),
  function(x, y=NULL)
  {
    if (is.null(y))
      ret = linalg_crossprod(x=DATA(x))
    else
      ret = linalg_matmult(transx=TRUE, transy=FALSE, x=DATA(x), y=DATA(y))

    wrapfml(ret)
  }
)

#' @rdname crossprod
#' @export
setMethod("tcrossprod", signature(x="fmlmat", y="ANY"),
  function(x, y=NULL)
  {
    if (is.null(y))
      ret = linalg_tcrossprod(x=DATA(x))
    else
      ret = linalg_matmult(transx=FALSE, transy=TRUE, x=DATA(x), y=DATA(y))

    wrapfml(ret)
  }
)


library(data.table)
library(rstan)
library(lognorm)
library(dplyr)

args = list(
  seed = 42,
  chain = 1,
  outdir= "~/Box\ Sync/2020/R0t/results/ifr_by_age_prior",
  indir = "~/git/R0t",
  datadir= "~/git/R0t/data",
  cmdstan = 1,
  #stanModelFile = 'base_age_prior_ifr_200820a7_cmdstanv',
  stanModelFile = 'base_age_prior_ifr_200820b5_cmdstanv',
  job_tag= 'new_data_spain_England',
  job_id='41286'
)

args$job_dir <- file.path(args$outdir,paste0(args$stanModelFile,'-',args$job_tag,'-',args$job_id))

outfile.base <- paste0(args$job_dir, "/",  args$stanModelFile , "-", args$job_tag)

# Outputs of the log normal fit from 28/08/2020
load(file.path(args$job_dir, paste0(basename(args$job_dir), '_stanout.RData')) )

fit = rstan:::sflist2stanfit(list(fit))

age_predict <- c(0, seq(2.5, 97.5, 5))
difrx <- rstan::extract(fit)[['pred_deaths']]
difrx <- as.data.table(reshape2::melt(difrx))
difrx <- setnames(difrx, 1:3, c('it','age.idx','pred_deaths'))
set(difrx, NULL, 'pred_deaths', difrx$pred_deaths/1e7)
set(difrx, NULL, 'logit_pred_deaths', difrx[, log(pred_deaths/(1-pred_deaths))])
set(difrx, NULL, 'log_pred_deaths', difrx[, log(pred_deaths)])
difrx <- melt(difrx, measure.vars=c('logit_pred_deaths','log_pred_deaths'))
difrx_sample <- difrx[is.finite(value),]
difrx <- difrx[is.finite(value), list(qs=quantile(value, p=c(0.025, 0.25, 0.5, 0.75, 0.975)), ql=c('CL','IL','M','IU','CU')), by=c('variable','age.idx')]
difrx <- dcast.data.table(difrx, variable+age.idx~ql, value.var='qs')
difrx[, age:= age.idx-1]
difrx[, age:= 5*(age.idx-1)]

# log ifr by age posterior
if(0){
  ggplot( subset(difrx, variable=='log_pred_deaths')) +
    geom_ribbon(aes(x=age, ymin=CL, ymax=CU)) +
    geom_line(aes(x=age, y=M))
}

#
# Find hyperparameters of log normal distribution
difrx = subset(difrx,  variable == "log_pred_deaths")
tmp = select(difrx, -variable)
# aggregate 85-100 to 85+
tmp1 = tmp[age >= 85, list(M = mean(M), IU = mean(IU), IL = mean(IL), CU = mean(CU), CL = mean(CL), age.idx = min(age.idx), age = min(age))]
tmp = rbind(subset(tmp, age < 85), tmp1)
tmp[, age_cat_label := ifelse(age == "85", "85+", paste0(age, "-", age + 4))]
tmp[, ifr_mean := exp(M)]
tmp[, ifr_cl := exp(CL)]
tmp[, ifr_cu := exp(CU)]
tmp = tmp[, list(ln_mu = getParmsLognormForMedianAndUpper(median = ifr_mean, quant = ifr_cu, sigmaFac=2)[1],
                 ln_sd = getParmsLognormForMedianAndUpper(median = ifr_mean, quant = ifr_cu, sigmaFac=2)[2],
                 ifr_mean = ifr_mean,
                 ifr_cl = ifr_cl,
                 ifr_cu = ifr_cu), by = c("age.idx", "age_cat_label", "age")]
#
# Find hyperparameters beta distribution
library("prevalence")
tmp[, ifr_beta_alpha := betaExpert(ifr_mean, ifr_cl, ifr_cu, p = 0.95, method = "mean")$alpha, by = c("age_cat", "age.idx",  "age")]
tmp[, ifr_beta_beta := betaExpert(ifr_mean, ifr_cl, ifr_cu, p = 0.95, method = "mean")$beta, by = c("age_cat", "age.idx",  "age")]

#
# check lognormal fit to posterior density estimate
if(0){
  tmp1 = list()
  begin_x = c(rep(-15, 10), rep(-10, 3), rep(-5, 4), rep(-2.5, 4))
  for(i in 1:nrow(tmp)){
    xx = seq(begin_x[i], 0, 0.01)

    tmp1[[i]] = data.table(x = xx, age = tmp$age[i], age.idx = tmp$age.idx[i], model = "log normal - gp")
    tmp1[[i]][, pd := dnorm(x, tmp$ln_mu[i], tmp$ln_sd[i])]
  }
  tmp1 = do.call("rbind", tmp1)

  difrx_sample[, age:= age.idx-1]
  difrx_sample[, age:= 5*(age.idx-1)]

  ggplot(subset(difrx_sample, variable == "log_pred_deaths"), aes(x = value)) +
    geom_density() +
    facet_wrap(age~., scales = "free") +
    geom_line(data = tmp1, aes(x = x, y = pd), col = "red", linetype = "dashed") +
    facet_wrap(age~., scales = "free") +
    theme_bw()
}

#
# Clean
setnames(tmp, "age.idx", "age_cat")
tmp = select(tmp, -age)

#
# Plot comparison to Levin's prior
prior_betabinom = tmp
prior_betabinom[, model := "BetaBinomial with logit link"]
prior_betabinom[, ln_cl := log(qlnorm(0.025, ln_mu, ln_sd))]
prior_betabinom[, ln_cu := log(qlnorm(0.975, ln_mu, ln_sd))]
prior_betabinom = select(prior_betabinom, model, age_cat, age_cat_label, ln_mu, ln_cl, ln_cu)

prior_levin = as.data.table(read.csv(file.path(args$indir,'data','ifr_age_Levin_200904.csv')))
prior_levin[, model := "Meta-analysis from Levin et al." ]
prior_levin[,age_cat_label := prior_betabinom$age_cat_label]
prior_levin[, ln_cl := log(qlnorm(0.025, ln_mu, ln_sd))]
prior_levin[, ln_cu := log(qlnorm(0.975, ln_mu, ln_sd))]
prior_levin = select(prior_levin, model, age_cat, age_cat_label, ln_mu, ln_cl, ln_cu)

priors = rbind(prior_betabinom, prior_levin)

ggplot(priors) +
  geom_line(aes(x = age_cat, y = ln_mu, col = model)) +
  geom_ribbon(aes(x = age_cat, ymin = ln_cl, ymax = ln_cu, fill = model), alpha = 0.5)+
  scale_x_continuous(breaks = prior_betabinom$age_cat, labels = prior_betabinom$age_cat_label) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 40, hjust = 0.9)) +
  labs(y = "Infection Fatality Rate Prior (log scale)") +
  theme(legend.position = "bottom") +
  scale_color_manual(values = c("black", "red"))+
  scale_fill_manual(values = c("gray60", "#F1A340")) +
  guides(fill=guide_legend(nrow=2,byrow=TRUE), color=guide_legend(nrow=2,byrow=TRUE))
ggsave(file = paste0(outfile.base, "-comparison_ifr_prior_betabinom_lognormal.png"), w = 6, h = 6)

#
# save new prior
file = file.path(args$datadir,'ifr_age_200902.csv')
cat("write ", file)
write.csv(tmp, file = file)

#
# Save hyperparameters for the paper
file = paste0(outfile.base, "-prior_hyperparameters.rds")
cat("write ", file)
tmp1 = matrix(ncol = nrow(tmp), nrow = 2, c(tmp$ln_mu, tmp$ln_sd), byrow = T)
saveRDS(tmp1, file = file, version = 2)


#' ---
#' title: "Script 2 of pipeline: read in workspace from script1, run alpha 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(vegan)
library(patchwork)
library(psych)
library(corrplot)

# 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"))

#' ```

#' ```

#' **Here we calculate alpha diversity measure, make some comparisons, and plot**

#' *BACTERIA*

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

#' **WP3 BACTERIA**

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

# how to transform data for alpha 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")

# see rarefaction curves
rarecurve(t(otu_table(WP3_initial_bact)), step=50, cex=0.5)

# most of the sample are in the 40k-70k reads, the min sample is fairly different from the other
# create rarefied phyloseq object, remove sample "E149.40.T0", both time point as is lower outlier for total reads
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)

# now, following P. Schloss (https://www.biorxiv.org/content/10.1101/2020.12.11.422279v1.abstract) alpha
# diversity would be impacted by removing of rare ASVs to a certain treshold, and to minimize different
# library size effect, he perform rarefaction. Sound fair conceptually, at least for alpha diversity

# calculate all indices.
alphadiv_WP3_bact <- microbiome::alpha(WP3_raref_bact)
df <- as(sample_data(WP3_raref_bact), "data.frame")
df <- cbind(df, alphadiv_WP3_bact)

df1 <- as(sample_data(WP3_raref_bact), "data.frame")
df1 <- cbind(df1[,c(3,4,10,11,12,13)], alphadiv_WP3_bact)

write.csv2(x =  df1, file = "alphadiv_WP3.csv")

df1 %>%
  filter(Time == "T3", Diet == "PVD" | Diet == "CTR")  %>%
  select(-c(Time, Diet, start_body_weight)) %>%
  corr.test(method = "pearson", adjust = "BH") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r), type="lower", order="hclust",
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

ggboxplot(data = df, x = "Time", y = "observed", add = "jitter",
          fill = "Time", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test", comparisons = list(c("T0","T3")), paired = T) +
  facet_grid(.~Diet) +
  ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness") + guides(fill="none") #+ ylim(c(100,1000))

ggboxplot(data = df, x = "Time", y = "chao1", add = "jitter",
          fill = "Time", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test", comparisons = list(c("T0","T3")), paired = T) +
  facet_grid(.~Diet) +
  ggtitle(label = "Bacteria", subtitle =  "Richness (ChaoI index)") +
  ylab("Richness") + guides(fill="none") #+ ylim(c(100,1000))

ggboxplot(data = df, x = "Time", y = "evenness_pielou", add = "jitter",
          fill = "Time", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test", comparisons = list(c("T0","T3")), paired = T) +
  facet_grid(.~Diet) +
  ggtitle(label = "Bacteria", subtitle =  "Pielou's Evenness") +
  ylab("Evenness") + guides(fill="none") #+ ylim(c(100,1000))

ggboxplot(data = df, x = "Time", y = "diversity_shannon", add = "jitter",
          fill = "Time", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test", comparisons = list(c("T0","T3")), paired = T) +
  facet_grid(.~Diet) +
  ggtitle(label = "Bacteria", subtitle =  "Shannon's index") +
  ylab("Shannon") + guides(fill="none") #+ ylim(c(100,1000))

## comparing at T3 respect to diet

df$Diet <- factor(df$Diet, levels = c("CTR", "MBD", "MBDT", "PVD"))

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "observed", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness (n° of observed ASVs)") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,1150) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain")) -> p_rich_2

df %>%
  filter(Diet == "PVD") %>%
  ggplot(aes(x = Time, y = observed)) +
  geom_boxplot(outlier.shape = NA, col = "grey50")+
  geom_jitter(width = 0.02, size = 2.5) +
  coord_flip() +
  theme_bw() +
  stat_compare_means(method = "t.test",comparisons = list(c("T0", "T3"))) +
  xlab("PVD subset") +
  ylab("") + theme(
    panel.background = element_rect(fill = "grey80", colour = "lightblue",
                                    size = 0.5, linetype = "solid"),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    axis.text.x = element_blank(),
    axis.ticks = element_blank()) -> p_rich_1

p_rich_2 + inset_element(p_rich_1, left = 0.05, bottom = 0.1, right = 0.95, top = 0.05) -> p_rich_final

ggsave('./PVD_bact_rich_WP3.png', p_rich_final)

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "observed", add = "jitter",
            fill = "Diet", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test",ref.group = "CTR") +
  ggtitle(label = "Bacteria", subtitle =  "Richness") +
  ylab("Richness") + guides(fill="none")

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "chao1", add = "jitter",
            fill = "Diet", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test",ref.group = "CTR") +
  ggtitle(label = "Bacteria", subtitle =  "Richness (ChaoI index)") +
  ylab("Richness") + guides(fill="none")

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "evenness_pielou", add = "jitter",
            fill = "Diet", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test",ref.group = "CTR") +
  ggtitle(label = "Bacteria", subtitle =  "Pielou's Evenness") +
  ylab("Evenness") + guides(fill="none")

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "diversity_shannon", add = "jitter",
            fill = "Diet", palette ="grey", rotate = F, dot.size = 4) + theme_bw() +
  stat_compare_means(method = "t.test",ref.group = "CTR") +
  ggtitle(label = "Bacteria", subtitle =  "Shannon's index") +
  ylab("Shannon") + guides(fill="none")

# inspect correlation between diet and alphadiv

df %>%
  filter(Time == "T3") %>%
  ggscatter(y = "observed", x = "Colon_tumor", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(12, 960), cor.coef.size = 4,
            add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  ylab("Richness (n° of observed ASVs)") +
  xlab("Tumours in the Colon") +
  stat_cor(aes(color = Diet), label.x = 12, method = "pearson") +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))  -> p_correl_rich

df %>%
  filter(Time == "T3") %>%
  ggscatter(y = "diversity_shannon", x = "Colon_tumor", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(12, 5), cor.coef.size = 4,
            add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  ylab("Shannon's Index") +
  xlab("Tumours in the Colon") +
  stat_cor(aes(color = Diet), label.x = 12, method = "pearson") +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain")) -> p_correl_shan

p_correl_rich/p_correl_shan +
  plot_layout(guides = "collect") & theme(legend.position = 'top') -> panel_correlation

p_rich_final + panel_correlation -> figure1

ggsave('./Figure1.png', figure1)

df %>%
  filter(Time == "T3") %>%
  ggscatter(y = "observed", x = "Colon_tumor", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(15, 960), cor.coef.size = 4,
            add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  ylab("Richness (n° of observed ASVs)") +
  xlab("Colon tumours") +
  stat_cor(aes(color = Diet), label.x = 15, method = "pearson") +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain")) -> p_correl_rich_2

df %>%
  filter(Time == "T3") %>%
  ggscatter(y = "diversity_shannon", x = "Colon_tumor", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(15, 5), cor.coef.size = 4,
            add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  ylab("Shannon's Index") +
  xlab("Colon tumours") +
  stat_cor(aes(color = Diet), label.x = 15, method = "pearson") +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain")) -> p_correl_shan_2

p_correl_rich_2/p_correl_shan_2 +
  plot_layout(guides = "collect") & theme(legend.position = 'top') -> panel_correlation_2

df %>%
  filter(Time == "T3") %>%
  ggscatter(y = "dominance_simpson", x = "Colon_tumor", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(15, 0.70), cor.coef.size = 4,
            add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  #ylab("Shannon's Index") +
  xlab("Colon tumours") +
  stat_cor(aes(color = Diet), method = "pearson") +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  filter(Time == "T3") %>%
  ggscatter(y = "rarity_log_modulo_skewness", x = "SI_tumour", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(8, 2.061), cor.coef.size = 4,
            add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  ylim(c(2.061, 2.062)) +
  #ylab("Shannon's Index") +
  xlab("SI tumour") +
  stat_cor(aes(color = Diet), method = "pearson") +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"))

df1 %>%
  filter(Time == "T3", Diet == "PVD" | Diet == "CTR") %>%
  ggscatter(y = "dominance_simpson", x = "Colon_tumor", shape = 21, fill = "Diet",col = "Diet", size = 3, cor.coef.coord = c(15, 0.7), cor.coef.size = 4,
                                                                 add = "reg.line", cor.coef = T, cor.method = "pearson") +
  scale_fill_manual(values = palette_custom) +
  scale_color_manual(values = palette_custom) +
  #ylab("Shannon's Index") +
  xlab("Colon tumours") +
  stat_cor(aes(color = Diet), method = "pearson") +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"))

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

#' **WP4 BACTERIA**

###########

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

# how to transform data for alpha diversity analysis?

# 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)
# variation in read depth is 8

# plot reads to find outliers; WP4-928 is lower outlier

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

# see rarefaction curves
rarecurve(t(otu_table(WP4_initial_bact)), step=50, cex=0.5)

# most of the sample are in the 40k-70k reads, the min sample is fairly different from the other
# create rarefied phyloseq object, remove sample "E149.40.T0", both time point as is lower outlier for total reads
WP4_raref_bact<- rarefy_even_depth(subset_samples(WP4_initial_bact, AnimalID != "WP4-928"),
                                   rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(subset_samples(WP4_initial_bact, AnimalID != "WP4-928")))),
                                   replace=F)

# now, following P. Schloss (https://www.biorxiv.org/content/10.1101/2020.12.11.422279v1.abstract) alpha
# diversity would be impacted by removing of rare ASVs to a certain treshold, and to minimize different
# library size effect, he perform rarefaction. Sound fair conceptually, at least for alpha diversity

# calculate all indices.
alphadiv_WP4_bact <- microbiome::alpha(WP4_raref_bact)
df <- as(sample_data(WP4_raref_bact), "data.frame")
df <- cbind(df, alphadiv_WP4_bact)

df$Time <- factor(df$Time, levels = c("Inoculum", "Tftm", "T0", "T3"))

df$Inoculum_diet <- factor(df$Inoculum_diet, levels = c("CTR", "MBD", "MBDT", "PVD"))

df1 <- as(sample_data(WP4_raref_bact), "data.frame")
df1 <- cbind(df1[,c(3,5,6,15)], alphadiv_WP4_bact)

write.csv2(x =  df1, file = "alphadiv_WP4.csv")

# calculate correlation matrix

df1 %>%
  filter(Time == "T3")  %>%
  select(-c(Time, Inoculum_diet,Type)) %>%
  corr.test(method = "pearson", adjust = "BH") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r), type="lower", order="hclust",
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

# In WP4 no correlations between MDF and diversity, maybe MDF are too early

# So, exploration here is more in the sense of time and diet of inoculum

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Inoculum_diet", y = "observed", add = "jitter",
            fill = "Inoculum_diet", palette ="grey", rotate = F, dot.size = 6) +
  theme_bw() +
  #geom_hline(data = df[df$Type == "Inoculum",], aes(yintercept = observed), linetype = 2) +
  facet_wrap(. ~ Time) +
  stat_compare_means(method = "t.test",comparisons = list(c("Tftm", "T0"),c("T0","T3"), c("Tftm","T3"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness (n° of observed ASVs)") +
  guides(fill="none") +
  xlab("") +
  ylim(350,1250) +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain")) #-> p_observed_WP4

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Time", y = "observed", add = "jitter",
            fill = "Time", palette ="grey", rotate = F, dot.size = 6) +
  theme_bw() +
  geom_hline(data = df[df$Type == "Inoculum",], aes(yintercept = observed), linetype = 2) +
  facet_wrap(. ~ Inoculum_diet) +
  stat_compare_means(method = "t.test",comparisons = list(c("Tftm", "T0"),c("T0","T3"), c("Tftm","T3"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness (n° of observed ASVs)") +
  guides(fill="none") +
  xlab("") +
  ylim(350,1250) +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain")) #-> p_observed_WP4

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Time", y = "evenness_pielou", add = "jitter",
            fill = "Time", palette ="grey", rotate = F, dot.size = 6) +
  theme_bw() +
  geom_hline(data = df[df$Type == "Inoculum",], aes(yintercept = evenness_pielou), linetype = 2) +
  facet_wrap(. ~ Inoculum_diet) +
  stat_compare_means(method = "t.test",comparisons = list(c("Tftm", "T0"),c("T0","T3"), c("Tftm","T3"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Pielou's Evenness") +
  guides(fill="none") +
  xlab("") +
  ylim(0.55,0.75) +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain")) #-> p_eve_WP4

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Time", y = "diversity_shannon", add = "jitter",
            fill = "Time", palette ="grey", rotate = F, dot.size = 6) +
  theme_bw() +
  geom_hline(data = df[df$Type == "Inoculum",], aes(yintercept = diversity_shannon), linetype = 2) +
  facet_wrap(. ~ Inoculum_diet) +
  stat_compare_means(method = "t.test",comparisons = list(c("Tftm", "T0"),c("T0","T3"), c("Tftm","T3"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Shannon's Index") +
  guides(fill="none") +
  xlab("Diet of donor rat")  +
  ylim(3,6) +
  theme(axis.text.x = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 14,  hjust = .5, vjust = .5, face = "plain")) #-> p_eve_WP4

### compare overall the diets of donor

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Inoculum_diet", y = "observed", shape = "Time",
            fill = "Inoculum_diet", palette ="grey", rotate = F, dot.size = 4) +
  theme_bw() +
  #stat_compare_means(method = "t.test",comparisons = list(c("CTR", "MBD"),c("CTR", "MBDT"), c("CTR", "PVD")), label = "p.signif") +
  #stat_compare_means(method = "t.test",comparisons = list(c("MBD", "MBDT"),c("MBD", "PVD"), c("MBDT", "PVD"))) +
    #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness (n° of observed ASVs)") +
  guides(fill="none", shape = "none") +
  xlab("Diet of donor rat") +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain")) -> p_WP4_1

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Inoculum_diet", y = "evenness_pielou", shape = "Time",
            fill = "Inoculum_diet", palette ="grey", rotate = F, dot.size = 4) +
  theme_bw() +
  #stat_compare_means(method = "t.test",comparisons = list(c("CTR", "MBD"),c("CTR", "MBDT"), c("CTR", "PVD")), label = "p.signif") +
  #stat_compare_means(method = "t.test",comparisons = list(c("MBD", "MBDT"),c("MBD", "PVD"), c("MBDT", "PVD"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Pielou's Evenness index") +
  guides(fill="none", shape = "none") +
  xlab("Diet of donor rat") +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))  -> p_WP4_2

df %>%
  filter(Time != "Inoculum") %>%
  ggboxplot(data = ., x = "Inoculum_diet", y = "diversity_shannon", shape = "Time",
            fill = "Inoculum_diet", palette ="grey", rotate = F, dot.size = 4) +
  theme_bw() +
  #stat_compare_means(method = "t.test",comparisons = list(c("CTR", "MBD"),c("CTR", "MBDT"), c("CTR", "PVD")), label = "p.signif") +
  #stat_compare_means(method = "t.test",comparisons = list(c("MBD", "MBDT"),c("MBD", "PVD"), c("MBDT", "PVD"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Shannon's Diversity index") +
  guides(fill="none", shape = "none") +
  xlab("Diet of donor rat")  +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))  -> p_WP4_3

p_WP4_1 + p_WP4_2 + p_WP4_3 -> p_alpha_WP4

# plot with WP3

(p_rich_final + panel_correlation) / p_alpha_WP4 + plot_layout(heights = c(2, 1)) -> figure1

ggsave('./Figure1.png', figure1)

# Use ordination analysis to evaluate if overall time or diet has the highest contribution to the alpha diversity

df %>%
  filter(Time != "Inoculum") -> df_ord

df %>%
  filter(Time != "Inoculum") %>%
  select(-c(1,2,4:15)) %>%
  mutate(across(Time, as.numeric)) %>%
  scale(.) %>%
  PCA(na.omit(.), graph = FALSE) %>%
  fviz_pca_biplot(.,pointsize = 4, invisible = "quali", habillage = df_ord$Inoculum_diet,
                  col.ind = df_ord$Inoculum_diet,
                  col.var = "gray", alpha.var =0.8, repel = T,
                  label = "var") +
  geom_text_repel(label = df_ord$Time, nudge_x = 0.2, nudge_y = 0.2)

#####

#' *FUNGI*

#' **WP3 FUNGI**

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

# how to transform data for alpha diversity analysis?

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

# plot reads to find outliers

sdt %>%
  filter(AnimalID != "E149-60" & AnimalID != "E149-15") %>%
  #filter(AnimalID != "E149-15") %>%
  ggboxplot(.,y = "TotalReads", label = "AnimalID")

# see rarefaction curves
rarecurve(t(otu_table(WP3_initial_fung)), step=50, cex=0.5)
# most of the sample are in the 40k-70k reads, the min sample is fairly different from the other
# create rarefied phyloseq object, remove sample "E149.40.T0", both time point
WP3_raref_fung<- rarefy_even_depth(subset_samples(WP3_initial_fung, AnimalID != "E149-60" & AnimalID != "E149-15"), rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(subset_samples(WP3_initial_fung, AnimalID != "E149-60" & AnimalID != "E149-15")))),
                                   replace=F)

# now, following P. Schloss (https://www.biorxiv.org/content/10.1101/2020.12.11.422279v1.abstract) alpha
# diversity would be impacted by removing of rare ASVs to a certain treshold, and to minimize different
# library size effect, he perform rarefaction. Sound fair conceptually, at least for alpha diversity

# calculate all indices.
alphadiv_WP3_fung <- microbiome::alpha(WP3_raref_fung)
df <- as(sample_data(WP3_raref_fung), "data.frame")
df <- cbind(df, alphadiv_WP3_fung)

df1 <- as(sample_data(subset_samples(WP3_initial_fung, AnimalID != "E149-60" & AnimalID != "E149-15")), "data.frame")
df1 <- cbind(df1[,c(3,4,10,11,12,13)], alphadiv_WP3_fung)

df1 %>%
  filter(Time == "T3")  %>%
  select(-c(Time, Diet, start_body_weight)) %>%
  corr.test(method = "pearson", adjust = "BH") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r), type="lower", order="hclust",
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

df$Diet <- factor(df$Diet, levels = c("CTR", "MBD", "MBDT", "PVD"))

## no correlation found between fungi and tumour counts, so exploration to see difference in diet

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "observed", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "anova") +
  #stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"),
  #                                                        c("MBDT", "MBD"), c("MBDT","CTR"),
  #                                                        c("MBD", "CTR"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness (n° of observed ASVs)") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,70) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  ggboxplot(data = ., x = "Time", y = "observed", add = "jitter",
            fill = "Time", rotate = F, dot.size = 6) + theme_bw() +
  facet_wrap(. ~ Diet) +
  stat_compare_means(method = "t.test") +
  ylab("Richness (n° of observed ASVs)") +
  scale_fill_grey() +
  guides(fill="none") +
  xlab("") +
  ylim(0,70) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

###

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "diversity_shannon", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "anova") +
  #stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"),
  #                                                        c("MBDT", "MBD"), c("MBDT","CTR"),
  #                                                        c("MBD", "CTR"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Shannon's Index") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,3.5) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  ggboxplot(data = ., x = "Time", y = "diversity_shannon", add = "jitter",
            fill = "Time", rotate = F, dot.size = 6) + theme_bw() +
  facet_wrap(. ~ Diet) +
  stat_compare_means(method = "t.test") +
  ylab("Shannon's Index") +
  scale_fill_grey() +
  guides(fill="none") +
  xlab("") +
  ylim(0,3.5) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

###

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "evenness_pielou", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "anova") +
  #stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"),
  #                                                        c("MBDT", "MBD"), c("MBDT","CTR"),
  #                                                        c("MBD", "CTR"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Pielou's Evenness Index") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,1) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  ggboxplot(data = ., x = "Time", y = "evenness_pielou", add = "jitter",
            fill = "Time", rotate = F, dot.size = 6) + theme_bw() +
  facet_wrap(. ~ Diet) +
  stat_compare_means(method = "t.test") +
  ylab("Pielou's Evenness Index") +
  scale_fill_grey() +
  guides(fill="none") +
  xlab("") +
  ylim(0,1) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

#' **WP4 FUNGI**

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

# how to transform data for alpha diversity analysis?

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

# plot reads to find outliers

sdt %>%
  #filter(AnimalID != "E149-60" & AnimalID != "E149-15") %>%
  #filter(AnimalID != "E149-15") %>%
  ggboxplot(.,y = "TotalReads", label = "AnimalID")

# see rarefaction curves
rarecurve(t(otu_table(WP3_initial_fung)), step=50, cex=0.5)

# most of the sample are in the 40k-70k reads, the min sample is fairly different from the other
# create rarefied phyloseq object, remove sample "E149.40.T0", both time point
WP4_raref_fung<- rarefy_even_depth(WP4_initial_fung, rngseed=1234,
                                   sample.size=round(0.99*min(sample_sums(WP4_initial_fung))),
                                   replace=F)

# now, following P. Schloss (https://www.biorxiv.org/content/10.1101/2020.12.11.422279v1.abstract) alpha
# diversity would be impacted by removing of rare ASVs to a certain treshold, and to minimize different
# library size effect, he perform rarefaction. Sound fair conceptually, at least for alpha diversity

# calculate all indices.
alphadiv_WP3_fung <- microbiome::alpha(WP3_raref_fung)
df <- as(sample_data(WP3_raref_fung), "data.frame")
df <- cbind(df, alphadiv_WP3_fung)

df1 <- as(sample_data(subset_samples(WP3_initial_fung, AnimalID != "E149-60" & AnimalID != "E149-15")), "data.frame")
df1 <- cbind(df1[,c(3,4,10,11,12,13)], alphadiv_WP3_fung)

df1 %>%
  filter(Time == "T3")  %>%
  select(-c(Time, Diet, start_body_weight)) %>%
  corr.test(method = "pearson", adjust = "BH") ->  cor_test_mat  # Apply corr.test function

corrplot(as.matrix(cor_test_mat$r), type="lower", order="hclust",
         p.mat = as.matrix(cor_test_mat$p), sig.level = 0.05)

df$Diet <- factor(df$Diet, levels = c("CTR", "MBD", "MBDT", "PVD"))

## no correlation found between fungi and tumour counts, so exploration to see difference in diet

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "observed", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "anova") +
  #stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"),
  #                                                        c("MBDT", "MBD"), c("MBDT","CTR"),
  #                                                        c("MBD", "CTR"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Richness (n° of observed ASVs)") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,70) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  ggboxplot(data = ., x = "Time", y = "observed", add = "jitter",
            fill = "Time", rotate = F, dot.size = 6) + theme_bw() +
  facet_wrap(. ~ Diet) +
  stat_compare_means(method = "t.test") +
  ylab("Richness (n° of observed ASVs)") +
  scale_fill_grey() +
  guides(fill="none") +
  xlab("") +
  ylim(0,70) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

###

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "diversity_shannon", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "anova") +
  #stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"),
  #                                                        c("MBDT", "MBD"), c("MBDT","CTR"),
  #                                                        c("MBD", "CTR"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Shannon's Index") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,3.5) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  ggboxplot(data = ., x = "Time", y = "diversity_shannon", add = "jitter",
            fill = "Time", rotate = F, dot.size = 6) + theme_bw() +
  facet_wrap(. ~ Diet) +
  stat_compare_means(method = "t.test") +
  ylab("Shannon's Index") +
  scale_fill_grey() +
  guides(fill="none") +
  xlab("") +
  ylim(0,3.5) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

###

df %>%
  filter(Time == "T3") %>%
  ggboxplot(data = ., x = "Diet", y = "evenness_pielou", add = "jitter",
            fill = "Diet", rotate = F, dot.size = 6) + theme_bw() +
  stat_compare_means(method = "anova") +
  #stat_compare_means(method = "t.test",comparisons = list(c("PVD", "CTR"), c("PVD","MBD"), c("PVD", "MBDT"),
  #                                                        c("MBDT", "MBD"), c("MBDT","CTR"),
  #                                                        c("MBD", "CTR"))) +
  #ggtitle(label = "Bacteria", subtitle =  "Richness (n° of ASVs)") +
  ylab("Pielou's Evenness Index") +
  scale_fill_manual(values = palette_custom) +
  guides(fill="none") +
  xlab("") +
  ylim(0,1) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

df %>%
  ggboxplot(data = ., x = "Time", y = "evenness_pielou", add = "jitter",
            fill = "Time", rotate = F, dot.size = 6) + theme_bw() +
  facet_wrap(. ~ Diet) +
  stat_compare_means(method = "t.test") +
  ylab("Pielou's Evenness Index") +
  scale_fill_grey() +
  guides(fill="none") +
  xlab("") +
  ylim(0,1) +
  theme(axis.text.x = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.text.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"),
        axis.title.y = element_text(size = 12,  hjust = .5, vjust = .5, face = "plain"))

#' ```

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

# use ggsave for images

#' ```


# build a demo data set

surfaces = c('G8_A', 'G8_B', 'G8_C', 'G8_D', 'G10_A', 'G10_B', 'G10_C', 'G10_D', 'T1_A', 'T1_C', 'T1_E')

for(i in surfaces) {
	name = paste(i, '.csv',sep = "")
	raw <- read.csv(name, header = TRUE, sep=",")
	dat <- melt(raw,id.vars='xi')

	mn <- tapply(dat$value, dat$xi, min)
	mm <- tapply(dat$value, dat$xi, mean)
	mx <- tapply(dat$value, dat$xi, max)
	d_min <- data.frame(x=names(mn), y=unname(mn))
	d_max <- data.frame(x=names(mx), y=unname(mx))
	d_mean <- data.frame(x=names(mm), y=unname(mm))

	d_range <- data.frame(x=raw$xi, value=d_mean$y, Min=d_min$y, Max = d_max$y)

	p1 <- ggplot(dat,aes(x=xi,y=value))+scale_y_continuous(breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5), limits = c(0, 0.5))+scale_x_continuous(breaks = c(-3,-2,-1,0,1,2,3,4,5), limits = c(-3, 5))+geom_ribbon(data=d_range,aes(ymin=Max,ymax=Min,x=x),fill = "grey50",group = 1, alpha=.3)+geom_point(aes(x=xi,y=value,group=variable), colour = "grey20", alpha=0.5, size=.5)+stat_summary(fun.y = "mean", colour = "black", size = 2,  geom = "line")+theme_bw(base_size = 14)+labs(title = name, x=expression(xi), y='f')

	ggsave(paste(i, '2.pdf',sep = ""), width = 5, height = 5, dpi = 220)
}


require(signal)

a = c(1.000000000000000, -3.316807910624417, 4.174245550076570, -2.357402780562255, 0.503375360741703)
b = c(0.000213138726975, 0.000852554907900, 0.001278832361851, 0.000852554907900, 0.000213138726975)

#x = c(1, rep(0, 99)) # This generates the intial input for initial input response

#xt = read.table("ButterworthIn2.txt")

#x = xt[["V1"]]

x = round(runif(300, 0, 1) * 8) / 8

write(x, "ButterworthIn3.txt", ncolumns = 1)

waveform = filter(b, a, x)

write(waveform, "ButterworthOut3.txt", ncolumns = 1)


#' backsolve
#'
#' Solve a triangular system.
#'
#' @param r,l
#' A triangular coefficients matrix.
#' @param x
#' The right hand sides.
#' @param k
#' The number of equations (columns of r + rows of x) to use.
#' @param upper.tri
#' Should the upper triangle be used? (if not the lower is)
#' @param transpose
#' Should the transposed coefficients matrix be used? More efficient than
#' manually transposing with \code{t()}.
#'
#' @examples
#' library(float)
#'
#' s = flrunif(10, 3)
#' cp = crossprod(s)
#' y = fl(1:3)
#' backsolve(cp, y)
#'
#' @useDynLib float R_backsolve_spm
#' @name backsolve
#' @rdname backsolve
NULL

backsolve_float32 = function(r, x, k=ncol(r), upper.tri=TRUE, transpose=FALSE)
{
  if (is.integer(r))
  {
    if (is.float(x))
      r = fl(r)
  }

  if (is.integer(x))
  {
    if (is.float(r))
      x = fl(x)
  }

  if (is.double(r) || is.double(x))
  {
    if (is.float(r))
      r = dbl(r)
    if (is.float(x))
      x = dbl(x)

    backsolve(r, x, k, upper.tri, transpose)
  }
  else
  {
    if (!is.numeric(k) || k < 1 || k > nrow(r) || is.na(k))
      stop("invalid 'k' argument")

    ret = .Call(R_backsolve_spm, DATA(r), DATA(x), as.integer(upper.tri), as.integer(transpose), as.integer(k))
    float32(ret)
  }
}

forwardsolve_float32 = function(l, x, k=ncol(l), upper.tri=FALSE, transpose=FALSE)
{
  backsolve_float32(l, x, k, upper.tri, transpose)
}

#' @rdname backsolve
#' @export
setMethod("backsolve", signature(r="float32", x="float32"), backsolve_float32)

#' @rdname backsolve
#' @export
setMethod("backsolve", signature(r="float32", x="BaseLinAlg"), backsolve_float32)

#' @rdname backsolve
#' @export
setMethod("backsolve", signature(r="BaseLinAlg", x="float32"), backsolve_float32)

#' @rdname backsolve
#' @export
setMethod("forwardsolve", signature(l="float32", x="float32"), forwardsolve_float32)

#' @rdname backsolve
#' @export
setMethod("forwardsolve", signature(l="float32", x="BaseLinAlg"), forwardsolve_float32)

#' @rdname backsolve
#' @export
setMethod("forwardsolve", signature(l="BaseLinAlg", x="float32"), forwardsolve_float32)


#' Step 1: Define backbone and other parameters
library(tidyverse)
library(dyngen)

set.seed(10)
model <-
  initialise_model(
    num_tfs = 12,
    num_targets = 30,
    num_hks = 15,
    backbone = backbone_bifurcating(),
    verbose = TRUE,
    download_cache_dir = "~/.cache/dyngen",
    num_cores =
  )

plot_backbone_statenet(model)

plot_backbone_modulenet(model)

names(list_backbones())

#' Step 2: Generate transcription factors (TFs)
model <- generate_tf_network(model)
## Generating TF network
plot_feature_network(model, show_targets = FALSE)

#' Step 3: Sample target genes and housekeeping genes (HKs)
model <- generate_feature_network(model)
## Sampling feature network from real network
plot_feature_network(model)
plot_feature_network(model, show_hks = TRUE)

#' Step 4: Generate kinetics
model <- generate_kinetics(model)
## Generating kinetics for 72 features
## Generating formulae
plot_feature_network(model)
plot_feature_network(model, show_hks = TRUE)

#' Step 5: Simulate gold standard
model <- generate_gold_standard(model)
plot_gold_simulations(model) + scale_colour_brewer(palette = "Dark2")
plot_gold_expression(model, what = "x") # mrna
plot_gold_expression(model, label_changing = FALSE) # premrna, mrna, and protein

#' Step 6: Simulate cells.
model <- generate_cells(model)
plot_simulations(model)
plot_gold_simulations(model) + scale_colour_brewer(palette = "Dark2")
plot_gold_mappings(model, do_facet = FALSE) + scale_colour_brewer(palette = "Dark2")
plot_simulation_expression(model, 1:4, what = "x")

#' Step 7: Experiment emulation
model <- generate_experiment(model)

#' Step 8: Convert to a dynwrap object
dataset <- wrap_dataset(model)
library(dynplot)
plot_dimred(dataset)


# File:   BarCharts.R
# Course: R: An Introduction (with RStudio)

# LOAD DATASETS PACKAGES ###################################

library(datasets)

# LOAD DATA ################################################

?mtcars # Motor trend magazine Car Road Tests Dataset from 1974
head(mtcars)

# BAR CHARTS ###############################################

barplot(mtcars$cyl)             # Doesn't work

# Need a table with frequencies for each category
cylinders <- table(mtcars$cyl)  # Create table
barplot(cylinders)              # Bar chart
plot(cylinders)                 # Default X-Y plot (lines)

# CLEAN UP #################################################

# Clear environment
rm(list = ls())

# Clear packages
detach("package:datasets", unload = TRUE)  # For base

# Clear plots
dev.off()  # But only if there IS a plot

# Clear console
cat("\014")  # ctrl+L

# Clear mind :)


#' Book-crossing 2-way contingency table data
#'
#' 30x15 contingency table classifying book reviews by book ISBN (30 levels) and country of reviewer (15 levels).
#' The dataset appears as a list prepared for contingency table resampling conditional on the marginal totals.
#' Components of the list are A (the configuration matrix); y (marginal totals); x (true cell counts); lambda (cell means under independence model); and MarkovBasis (a matrix with columns corresponding
#' to the vectors in full Markov basis for the resampling problem).
#'
#' @docType data
#'
#' @usage data(BX2way)
#' @export
#' @examples
#' data(BX2way)
#' Xsampler(A=BX2way$A,y=BX2way$y,lambda=BX2way$lambda,Model="Uniform",Method="Gibbs",tune.par=0.5,combine=FALSE,burnin=50,ndraws=200)
"BX2way"


## Within-pair discordant MZ twins analysis (adjusted model, adults, blood DNAm)
# Authors: Suderman M., Odintsova V., van Dongen J.

library(limma)

# Load methylation data (betas)
# Load phenotype and covariate data (df)
# Variables for basic model
# familynumber
# sex
# age (age at DNA bloodsampling)
# smoking
# BMI
# Neut_Perc (neutrophils percentage)
# Mono_Perc (monocytes percentage)
# Eos_Perc (eosinophils percentage)
# Array_rownum (array rownumber)
# Sample_Plate (sample plate)
# hand01 (left-handedness variable: right-handed = 0, left-handed = 1)
# handdiscord (handedness discordance: discordant MZ twins = "disc handedness", concordant MZ twins = "conc handedness")

# remove cases without methylation data
OL <- intersect(rownames(df),rownames(betas))
df <- df[OL,]
beta <- beta[OL,]
table(rownames(df)==rownames(beta))

# sortby Family Number
df <- df[order(df$familynumber),]
betas <- betas[rownames(df),]
n.na <- apply(is.na(betas), 2, sum)
idx <- which(n.na < nrow(betas)-1)
betas <- betas[,idx]

# calculate residuals on the total sample
model <- model.matrix(~ BMI + smoking + Mono_Perc + Eos_Perc + Neut_Perc + Array_rownum + Sample_Plate, data=mydata)
fit <- lmFit(t(betas), model)
betas.res <- t(residuals(fit,t(betas)))

# select twins from discordant pairs (handedness discordance variable)
df <- df[which(!is.na(df$handdiscord)
                       & mydata$handdiscord == 'disc handedness'),]   # discordant MZ twins

left.data <- df[which(df$hand01 == 0),]
right.data <- df[which(df$hand01 == 1),]
right.idx = match(rownames(right.data), rownames(betas.res))
left.idx = match(rownames(left.data), rownames(betas.res))

# Testrun for 1 cpg to determine the number of estimates in output
df$CpGi <- betas[,1]
table(apply(is.na(betas.res), 2, sum))
Ncpgs <- ncol(betas)
results <- matrix(NA,nrow=Ncpgs,ncol=6)
table(right.data$familynumber==left.data$familynumber)# should give TRUE

# Run model for all CpGs and save output
for (i in 1:Ncpgs) {
    meth.left <- betas.res[left.idx,i]
    meth.right <- betas.res[right.idx,i]
    n <- sum(!is.na(meth.left)&!is.na(meth.right))
    if (n > 2) {
      stats <- t.test(meth.left, meth.right, paired=T)
      results[i,] <- c(stats$estimate, stats$statistic, stats$conf.int, stats$p.value, n)
  }
  else results[i,ncol(results)] <- NA
}

save(results, file= "ttestresults.RData",sep="_")

# END


library(edgeR)

#### INPUT ####

message("Reading input...")

# capture script arguments
args <- commandArgs(trailingOnly = FALSE)

# extract variables
countsFile <- args[grep("--counts",args)+1]
samples <- args[grep("--samples",args)+1]
group <- args[grep("--group",args)+1]
minCounts <- as.numeric(args[grep("--minCounts",args)+1])

# read count table
counts <- read.table(file = countsFile, header = TRUE, sep = "\t", stringsAsFactors = FALSE, quote = "", row.names = 1)

# prepare data frame with sample information
idToDf <- strsplit(samples, ",")[[1]]
groupToDf <- factor(strsplit(group, ",")[[1]])
sampleInfo <- data.frame(id = idToDf, group = groupToDf)

#### TMM NORMALIZATION TO HIPATHIA ####

message("Normalizing expression for hipathia...")

# create dgeList
countsHi <- counts[ , sampleInfo$id ]

# create DGEList object
dgeListHi <- DGEList(counts = as.matrix(countsHi), group = sampleInfo$group)

# calc TMM norm factors
dgeListHi <- calcNormFactors(object = dgeListHi, method = "TMM")

# get logCPM matrix normalized using TMMs
logCpmHi <- cpm(dgeListHi, log = TRUE, prior.count = 3)

#### TMM NORMALIZATION TO DE ####

message("Normalizing expression for DE...")

# create dgeList
counts <- counts[ , sampleInfo$id ]

# remove not expressed genes
counts <- counts[ rowSums(counts) >= minCounts , ]

# create DGEList object
dgeList <- DGEList(counts = as.matrix(counts), group = sampleInfo$group)

# calc TMM norm factors
dgeList <- calcNormFactors(object = dgeList, method = "TMM")

# get logCPM matrix normalized using TMMs
logCpm <- cpm(dgeList, log = TRUE, prior.count = 3)
logCpm <- data.frame(geneId = rownames(logCpm), logCpm)

#### DESIGN AND CONTRASTS ####

message("Creating design and pairwise comparisons...")

# create design matrix using group factor
design <- model.matrix( ~ 0 + group, data = sampleInfo)

# create all possible pairwise contrasts of group factor levels
combinations <- combn(colnames(design), 2)
contrasts <- paste0(combinations[2,], "-", combinations[1,])
cMatrix <- makeContrasts(contrasts = contrasts, levels = colnames(design))

#### PERFORM DE ANALYSIS ####

message("Performing DE analysis...")

# estimate dispersions
dgeList <- estimateDisp(dgeList, design)

# fit quasi-likelihood F-Tests
fit <- glmFit(dgeList, design)

# get list of topTags tables for every contrast
deList <- apply(cMatrix, 2, function(x) {

  test <- glmLRT(fit, contrast = x)
  table <- topTags(test, n = Inf)$table
  table <- data.frame(geneId = rownames(table), table)
  return(table)

})

# bind rows to get individual Df
df <- Reduce(rbind, deList)
df$comparison <- rep(names(deList), unlist(lapply(deList, nrow)))

#### OUTPUT ####

message("Writting output...")

# output logCPM matrix to hipathia
saveRDS(object = logCpmHi, file = "logCPMs_hipathia.rds")

# output logCPM matrix
write.table(x = logCpm, file = "logCPMs.tsv", sep = "\t", row.names = FALSE, quote = FALSE)

# output logCPM matrix
write.table(x = df, file = "differential_expression.tsv", sep = "\t", row.names = FALSE, quote = FALSE)

message("Done!")


getScore_using_K_folds <- function(dts, alg, k){
  nn <- dimnames(dts)[[2]]
  id_c <- which(nn=="class")
  if(id_c != ncol(dts)){
    nn <- c(nn[-id_c], nn[id_c])
    dts <- as.data.frame(dts)
    dts <- cbind(dts[,-1], dts[,1])
    names(dts) <- nn
  }
  dts$class <- as.factor(dts$class)
  rownames(dts) <- 1:nrow(dts)
  if(length(which(table(dts$class) < 10))>0) return(getScore_using_LeaveOneOut(dts, alg))

  folds <- createFolds(dts$class, k=k)

  result <- matrix(nrow = nrow(dts), ncol = 3)
  for(i in 1:k){
    classifier <- construcClassifiers(dts[-folds[[i]],], alg)
    re <- applyModel(classifier, dts[folds[[i]],], prob=T)
    result[folds[[i]],] <- cbind(re[,order(as.numeric(colnames(re)))],dts$class[folds[[i]]])
  }

  return(result)
}


# Scatter Plot
library(plotly)

set.seed(123)

x <- rnorm(1000)
y <- rchisq(1000, df = 1, ncp = 0)
group <- sample(LETTERS[1:5], size = 1000, replace = T)
size <- sample(1:5, size = 1000, replace = T)

ds <- data.frame(x, y, group, size)

p <- plot_ly(ds, x = x, y = y, mode = "markers", split = group, size = size) %>% layout(title = "Scatter Plot")
embed_notebook(p)


library(babynames)
library(tidyverse)

since1950 <- babynames %>%
  filter(year >= 1950) %>%
  mutate(sex=recode(sex, "F"="Female", "M"="Male"))

topnames<-since1950 %>%
  group_by(name) %>%
  summarize(total=sum(n)) %>%
  arrange(desc(total)) %>%
  slice(1:1000)

unisex_names_since1950 <- since1950 %>%
  inner_join(topnames) %>%
  group_by(name, sex, total) %>%
  summarize(sextotal=sum(n, na.rm=TRUE)) %>%
  spread(key=sex, value=sextotal) %>%
  mutate(ratio=(Male-Female)/total) %>%
  filter(abs(ratio) < .2)

unisex_data <- since1950 %>%
  filter(name %in% unisex_names_since1950$name)

write_csv(unisex_data, "data/unisex.csv")


#------- Neglected Future --------
# Dynamic plot of temperature anomolies with data from:
# Morice, Colin P., et al. "Quantifying uncertainties in global and
# regional temperature change using an ensemble of observational estimates:
# The HadCRUT4 data set." Journal of Geophysical Research: Atmospheres 117.D8 (2012).
# https://www.metoffice.gov.uk/hadobs/hadcrut4/data/current/download.html

# NB: I use the decadally-smoothed data, and include the most conservative uncertainty estimate.

library(ggplot2)
library(gganimate)
library(reshape2)

#library(ggplot2)
library(av)# for mpeg video output
#library(magick)

# Column 1 is the date.
# Column 2 is the median of the 100 ensemble member time series.
# Columns 3 and 4 are the lower and upper bounds of the 95% confidence interval of bias uncertainty computed from the 100 member ensemble.
# Columns 5 and 6 are the lower and upper bounds of the 95% confidence interval of measurement and sampling uncertainties around the ensemble median. These are the combination of fully uncorrelated measurement and sampling uncertainties and partially correlated uncertainties described by the HadCRUT4 error covariance matrices.
# Columns 7 and 8 are the lower and upper bounds of the 95% confidence interval of coverage uncertainties around the ensemble median.
# Columns 9 and 10 are the lower and upper bounds of the 95% confidence interval of the combination of measurement and sampling and bias uncertainties.
# Columns 11 and 12 are the lower and upper bounds of the 95% confidence interval of the combined effects of all the uncertainties described in the HadCRUT4 error model (measurement and sampling, bias and coverage uncertainties).

# setwd("~/")
df <- read.table("temp_dev_HadCRUT_annual_ns_avg_smooth.txt")

df <- df[,c("V1", "V2", "V11","V12")]
names(df) <- c('year', 'median', 'lower95','upper95')

head(df)

mlt <- melt(df[,c('year','median','lower95','upper95')], id.vars=c('year'))

#--- First, simple static plot:
p <- ggplot() + geom_line(aes(y=value, x=year, group=variable, color=variable), data=mlt)+theme_bw()+
  scale_x_continuous(breaks = c(1860, 1880, 1900, 1920, 1940, 1960, 1980, 2000, 2019 ))+
  scale_y_continuous(breaks = c(-0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8)) +
  ylab("temperature anomalies (deg C) relative to 1961-1990") + xlab("")

col.scale <- c("median" = "black", "lower95" = "lightgrey", "upper95"='lightgrey')
p + scale_colour_manual(values = col.scale)

#-------------------------
# Dynamic plot - transition_reveal
# view follow - axes dynamically revealed.
#------------------------

# red - reversed -> green
col.scale <- c("median" = "red", "lower95" = "lightgrey", "upper95"='lightgrey')

p <- ggplot(mlt, aes(year, value, color = variable)) +
  geom_line() +  geom_point(size = 2) +
  transition_reveal(year) + view_follow()+
  scale_x_continuous(breaks = c(1860, 1880, 1900, 1920, 1940, 1960, 1980, 2000, 2019 ))+
  scale_y_continuous(breaks = c(-0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8)) +xlab("") +
  labs(title = '', y = 'Temperature anomolies (°C), relative to 1961-1990',
       caption = "Neglected Future\nData from Hadley Centre, HadCRUT4; 95% confidence intervals from full error model\n(measurement, sampling, bias and coverage uncertainties). Decadally smoothed") +
  theme_minimal() + theme(legend.position = "none")+
  scale_colour_manual(values = col.scale)

myrenderer <- av_renderer('temperature_anoms_test.mp4',
    vfilter = 'negate=1, fade=in:0:15:color=black')
dd <- animate(p, renderer=myrenderer,
              width=1080, height=1920, res=100, fps=10)


 DPTRFS Example Program Results

 Solution(s)
             1          2
 1      2.5000     2.0000
 2      2.0000    -1.0000
 3      1.0000    -3.0000
 4     -1.0000     6.0000
 5      3.0000    -5.0000

 Backward errors (machine-dependent)
       0.0E+00    7.4E-17

 Estimated forward error bounds (machine-dependent)
       2.4E-14    4.7E-14


# Works in C:\Program Files\R\R-4.0.2\bin\x64

## Install piecewiseSEM from github
#library(devtools)
#install_github("jslefche/piecewiseSEM@devel", build_vignette = TRUE) # requires R version > 3.5

# Load library
library(piecewiseSEM)

##### load data
setwd('~/StabilityScaleUp')
varpart_All_prod <- read.csv('varpart_All_prod.csv')
head(varpart_All_prod)

#######################
#### Piecewise SEM ####
#######################

coefs_df = data.frame()
for(i in unique(varpart_All_prod$year_trt)) {
  for(j in unique(varpart_All_prod$trt)) {
     df <- varpart_All_prod[varpart_All_prod$year_trt==i&varpart_All_prod$trt==j,]
        model = psem(
        lm(log_gamma_stab_prod ~ log_spatial_asynch_prod + log_alpha_stab_prod, data=df),
        lm(log_alpha_stab_prod ~ log_spp_stab_cover + log_spp_asynch_cover, data=df),
        lm(log_spp_stab_cover ~ avg_richness2, data=df),
        lm(log_spp_asynch_cover ~ avg_richness2, data=df),
        lm(log_spatial_asynch_prod ~ beta_invsimpsons, data=df),
        avg_richness2 %~~% beta_invsimpsons,
        log_spp_stab_cover %~~% log_spp_asynch_cover,
        log_spp_stab_cover %~~% log_spatial_asynch_prod,
        log_spp_asynch_cover %~~% log_spatial_asynch_prod
        )
        coefs <- summary(model, .progressBar = F)$coefficients
        coefs$year <- i
        coefs$trt <- j
        names(coefs)[names(coefs) == ''] <- 'Sig'
        coefs_df = plyr::rbind.fill(coefs_df, coefs)
  }
}
# rename
names(coefs_df)[names(coefs_df) == 'Std.Estimate'] <- 'TE'; names(coefs_df)[names(coefs_df) == 'Std.Error'] <- 'seTE'
head(coefs_df)

# replace SE of 0 with 0.01
coefs_df$seTE[coefs_df$seTE==0] <- 0.01
# replace SE of NA with 0.01
coefs_df$seTE[is.na(coefs_df$seTE)] <- 0.01

# replace by numerical values
coefs_df$seTE <- as.numeric(as.character(coefs_df$seTE))

# replace NA with 0.01
coefs_df[is.na(coefs_df)] <- 0.01

#######################
#### Meta analysis ####
#######################

library(meta)

p1 <- coefs_df[coefs_df$Response=='log_gamma_stab_prod'&coefs_df$Predictor=='log_spatial_asynch_prod',]
p2 <- coefs_df[coefs_df$Response=='log_gamma_stab_prod'&coefs_df$Predictor=='log_alpha_stab_prod',]
p3 <- coefs_df[coefs_df$Response=='log_alpha_stab_prod'&coefs_df$Predictor=='log_spp_stab_cover',]
p4 <- coefs_df[coefs_df$Response=='log_alpha_stab_prod'&coefs_df$Predictor=='log_spp_asynch_cover',]
p5 <- coefs_df[coefs_df$Response=='log_spp_stab_cover'&coefs_df$Predictor=='avg_richness2',]
p6 <- coefs_df[coefs_df$Response=='log_spp_asynch_cover'&coefs_df$Predictor=='avg_richness2',]
p8 <- coefs_df[coefs_df$Response=='log_spatial_asynch_prod'&coefs_df$Predictor=='beta_invsimpsons',]
p9 <- coefs_df[coefs_df$Response=='~~avg_richness2'&coefs_df$Predictor=='~~beta_invsimpsons',]
p10 <- coefs_df[coefs_df$Response=='~~log_spp_stab_cover'&coefs_df$Predictor=='~~log_spp_asynch_cover',]
p11 <- coefs_df[coefs_df$Response=='~~log_spp_stab_cover'&coefs_df$Predictor=='~~log_spatial_asynch_prod',]
p12 <- coefs_df[coefs_df$Response=='~~log_spp_asynch_cover'&coefs_df$Predictor=='~~log_spatial_asynch_prod',]

# check whether estimates vary by treatment
out <- do.call(rbind, lapply(list(p1, p2, p3, p4, p5, p6, p8, p9, p10, p11, p12), function(i) {
  r <- i$Response[1]
  p <- i$Predictor[1]

  # Fit model with interaction
  model <- metagen(TE, seTE, studlab = paste(Response), comb.fixed = TRUE, comb.random = TRUE, prediction = TRUE, sm = "SMD", byvar = trt,
    data = subset(coefs_df, Response == r & Predictor == p))

  out <- data.frame(
    Response = r,
    Predictor = p,
    estimate_C = model$TE.fixed.w[1],
    ci.lb_C = model$lower.fixed.w[1],
    ci.ub_C = model$upper.fixed.w[1],
    estimate_F = model$TE.fixed.w[2],
    ci.lb_F = model$lower.fixed.w[2],
    ci.ub_F = model$upper.fixed.w[2]
  )

  return(out)

} ) )
out


m <- rep(16.482368, 1500)
u <- runif(8500)*80+20
c <- c(m, u)
#hist(c)
p <- c(0.5, 1, 5, 10, 25, 50, 75, 90, 95, 99, 99.5)/100
sta <- c("PCTL0.5","PCTL1","PCTL5","PCTL10","PCTL25","PCTL50",
         "PCTL75","PCTL90","PCTL95","PCTL99","PCTL99.5",
         "mean","var","stdev","count","sum",
         quantile(u,p),
         mean(u),var(u),sd(u),length(u),sum(u))
write(u, file="data/mass-point-left.dat", ncolumns=1)
write(u[1:5000], file="data/mass-point-left-chunk1.dat", ncolumns=1)
write(u[5001:10000], file="data/mass-point-left-chunk2.dat", ncolumns=1)
write(sta, file="data/mass-point-left.sta", ncolumns=16)
u<-sort(u,decreasing=FALSE)
write(u, file="data/mass-point-left-asc.dat", ncolumns=1)
u<-sort(u,decreasing=TRUE)
write(u, file="data/mass-point-left-desc.dat", ncolumns=1)


library(tydyr)
library(dplyr)
library(data.table)

# Part 1 - Merge data sets

setwd("C:/Users/user/Documents/GitHub/datasciencecoursera/getting_and_cleanign_data/UCI HAR Dataset")

# Reading files in tables
# About features in sets
features <- read.table("./features.txt", header = FALSE)

# About activity
typeActivity<- read.table('./activity_labels.txt', header = FALSE)

# About training
subjectsT<- read.table('./train/subject_train.txt', header = FALSE)
xTrain <- read.table('./train/x_train.txt', header=FALSE)
yTrain <- read.table('./train/y_train.txt', header=FALSE)

# Naming columns according to info
names(typeActivity)<- c("activityID", "activityType")
names(subjectsT)<- "subjectID"
names(xTrain)<- features[,2]
names(yTrain)<- "activityID"

# Training data complete
training<-cbind(yTrain, subjectsT, xTrain)

# About testing
subjectsTs<- read.table('./test/subject_test.txt', header = FALSE)
xTest <- read.table('./test/x_test.txt', header=FALSE)
yTest <- read.table('./test/y_test.txt', header=FALSE)

names(subjectsTs) <- "subjectID"
names(xTest) <- features[,2]
names(yTest) <- "activityID"

# Data about tests

tests <-cbind(yTest,subjectsTs,xTest)

# Now I have data about testing and training so I combine them
finalT<- rbind(training, tests)

# Part 2 - Extract only the measurements on the mean and standard deviation for each measurement

#Retrieving names
naMes<-names(finalT)

#Creating a vector with TRUE or FALSE
neededCol <- (grepl("activity..", naMes)|grepl("subject..", naMes)| grepl("-mean..",naMes) & !grepl("-meanFreq..",naMes) & !grepl("mean..-",naMes) | grepl("-std..",naMes) & !grepl("-std()..-",naMes) == "TRUE")

# Retrieving needed data
ndData<- finalT[neededCol == TRUE]

# Part 3 - Use descriptive activity names to name the activities in the data set

mergedData<-merge(ndData, typeActivity, by = "activityID", all.x = TRUE)

# Part 4 - Appropriately label the data set with descriptive variable names.

#Retrieving names (one more time, because data changed in Part 3)

naMes <- names(mergedData)

# Renaming
for (name in 1:length(naMes)) {
        naMes[name] <- gsub ("\\()","",naMes[name])
        naMes[name] = gsub("-std$","StandartDev",naMes[name])
        naMes[name] = gsub("-mean","Mean",naMes[name])
        naMes[name] = gsub("^(t)","Time",naMes[name])
        naMes[name] = gsub("^(f)","Frequency",naMes[name])
        naMes[name] = gsub("([Gg]ravity)","Gravity",naMes[name])
        naMes[name] = gsub("([Bb]ody[Bb]ody|[Bb]ody)","Body",naMes[name])
        naMes[name] = gsub("[Gg]yro","Gyroscope",naMes[name])
        naMes[name] = gsub("AccMag","AccMagnitude",naMes[name])
        naMes[name] = gsub("([Bb]odyaccjerkmag)","BodyAccJerkMagnitude",naMes[name])
        naMes[name] = gsub("JerkMag","JerkMagnitude",naMes[name])
        naMes[name] = gsub("GyroMag","GyroMagnitude",naMes[name])
        naMes[name] = gsub("[Mm]ag","Magnitude",naMes[name])
}

# Applying names to columns
names(mergedData) <- naMes

# Part 5 - create a second, independent tidy data
# set with the average of each variable for each activity and each subject
final<-select(mergedData, -contains("activityType"))
tidyData = aggregate(final[,names(final) != c('activityID','subjectID')],by=list(activityID=final$activityID,subjectId = final$subjectID),mean);

# Merging the tidyData with activityType to include activity names
tidyData = merge(tidyData,typeActivity,by='activityID',all.x=TRUE);

# Saving
write.table(tidyData, './tidyData.txt',row.names=TRUE,sep='\t')


try_install <- function(package_names)
{
  for(n in package_names)
  {
    success = library(n, "logical.return" = TRUE, "character.only" = TRUE)
    if(!success)
    {
      paste(">> INSTALLING", n, "PACKAGE", " ")
      install.packages(n, repos='http://cran.cnr.berkeley.edu')
      library(n, "character.only" = TRUE)
    }
  }
}

# load required packages
try_install(c("scales", "ggplot2", "RColorBrewer"))
library("RColorBrewer")

# Parse args
args <- commandArgs(TRUE)
if(is.na(args[1])) {
  ">> ERROR: Missing output filename"
  q(status=1)
} else {
  outputfile = args[1]
}

# Load data
data = read.table('tmp/data-dist.ssv', header=T, sep=" ")

# Convert count to fraction of total count
total_counts <- sum(data$count)
data$percent <- data$count / total_counts
data$buckets <- with(data, reorder(buckets, order))

# Set up plot
png(outputfile, width=8, height=6, units = 'in', res=150)

# Set up colors
cols = brewer.pal(9, 'Set1')

# Add bars
bar_chart <- ggplot(data, aes(x=buckets, y=percent, color=cols[2], fill=cols[2])) +
  theme_bw() +
  geom_bar(stat="identity") +
  xlab("Response Time (ms)") +
  ylab("Percent") +
  scale_y_continuous(labels = percent_format(), limits=c(0,1))

if(is.na(args[2])) {
  bar_chart <- bar_chart + labs(title = "Response Time Distribution")
} else {
  bar_chart <- bar_chart + labs(title = args[2])
}

fortify_pareto_data <- function(data, xvar, yvar, sort = TRUE)
{
  for(v in c(xvar, yvar))
  {
    if(!(v %in% colnames(data)))
    {
      stop(sQuote(v), " is not a column of the dataset")
    }
  }

  if(sort) {
    o <- order(data[, yvar], decreasing = TRUE)
    data <- data[o, ]
    data[, xvar] <- factor(data[, xvar], levels = data[, xvar])
  }

  data[, yvar] <- as.numeric(data[, yvar])
  data$.cumulative.y <- cumsum(data[, yvar])

  data$.numeric.x <- as.numeric(data[, xvar])
  data
}

fortified_data <- fortify_pareto_data(data, "buckets", "percent", sort=FALSE)

pareto_plot <- bar_chart %+% fortified_data +
    geom_line(aes(.numeric.x, .cumulative.y, colour=cols[1])) +
    ylab("Cumulative Percentage") +
    scale_fill_identity() +
    scale_color_identity() +
    scale_y_continuous(labels = percent_format(), limits=c(0,1))
pareto_plot


version https://git-lfs.github.com/spec/v1
oid sha256:0f89ba7c7464e099d36f7583d7caa9b4404f6f9d204628f2c8c16ae36765644a
size 20800


# https://github.com/harrelfe/rms/issues/55

require(rms)
set.seed(1)
n <- 20
X2 <- factor(c(rep(0, n/2), rep(1, n/2)))
X21 <- rep(1 : (n/2), 2)
y <- rep(0 : 1, n/2)
options(rmsdebug=TRUE)
f <- lrm(y ~ X2 + X21, method='model.frame')
attributes(f)$Design$mmcolnames

# Problem is inherent to R
colnames(model.matrix(~ X2 + X21))

## https://github.com/harrelfe/rms/issues/29#issuecomment-417901353
d <- data.frame(
  X = sample(1:700),
  Y = sample(c("yes", "no"),700, replace = TRUE),
  Z = sample (c("Back pain", "Leg Pain", "Back pain = Leg pain"),700, replace = TRUE)
)
options(rmsdebug=TRUE)
lrm(Y~X+Z, data=d)

d$Z <- sample(c("Back pain", "Leg Pain", "Back pain = Leg pain"),700, replace = TRUE)
lrm(Y~X+Z, data=d)


pdf_file<-"pdf/timeseries_areas_corridor_2x2.pdf"
cairo_pdf(bg="grey98", pdf_file,width=10.65,height=9.2)

source("scripts/inc_datadesign_dbconnect.r")
par(mai=c(0.6,0.5,0,0),omi=c(0.2,0.5,1.25,0.25),mfcol=c(2,2),family="Lato Light",las=1)

# Import data and prepare chart

myColour1_150<-rgb(68,90,111,150,maxColorValue=255)
myColour2_150<-rgb(255,97,0,150,maxColorValue=255)

y1variable<-c("England_Weizen",
			  "Frankreich_Weizen",
			  "Niederlande_Roggen",
			  "Oesterreich_Roggen")
y2variable<-c("Belgien_Weizen",
			  "Oberitalien_Weizen",
			  "Deutschland_Roggen",
			  "Polen_Roggen")

y1label<-c("England\n(Wheat)",
				  "France\n(Wheat)",
				  "Netherlands\n(Rye)",
				  "Austria\n(Rye)")
y2label<-c("Belgiun\n(Wheat)",
				  "North Italy\n(Wheat)",
				  "Germany\n(Rye)",
				  "Poland\n(Rye)")

for (i in 1:length(y1variable))
{
sql<-paste("select jahr x,",y1variable[i]," y1,",y2variable[i]," y2,Min_Getreide,Max_Getreide from z8082 where jahr > 0",sep="")
rs<-dbGetQuery(con,sql)

attach(rs)

# Create chart and other elements

plot(x,y1,axes=F,type="n",xlab="",ylab="",cex.lab=0.8,xlim=c(1200,2000),ylim=c(0,250),xpd=T)
xx<-c(x,rev(x))
yy<-c(Max_Getreide,rev(Min_Getreide))
polygon(xx,yy,col=rgb(68,90,111,80,maxColorValue=255),border=F)
lines(x,y1,type="l",col=myColour1_150,lwd=3,xpd=T)
lines(x,y2,type="l",col=myColour2_150,lwd=3)
text(1600,200,y1label[i],adj=0,cex=1.3,col=myColour1_150)
text(1810,25,y2label[i],adj=0,cex=1.3,col=myColour2_150)
if (i==2 | i==4) axis(1,at=c(1200,1400,1600,1800,2000))
axis(2,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
}

# Titling

mtext("Prices for wheat and rye in Europe 1200-1960",3,line=3,adj=0,family="Lato Black",cex=1.8,outer=T)
mtext("in g silver/100 kg, decennial means",3,line=1,adj=0,font=3,cex=1.2,outer=T)
dev.off()