# install.packages("pacman")
library(pacman)
p_load(tidyverse, tidylog, purrr, colorspace, flextable) # Basic
p_load(textrecipes, tidytext, stopwords, wordcloud) # Text processing helpers

set.seed(100)

df <- read_csv("Data/2020 Mortality Data_clean.csv")

# Tables
## Number of cases per county
df %>%
  group_by(County) %>%
  summarise(n = n()) %>%
  mutate(Percentage = round(n / sum(n) * 100, 1)) %>%
  arrange(desc(n))

## Descriptives for text
df %>%
  summarize(
    Min = min(nchar(text)),
    Q1 = quantile(nchar(text), .25),
    Mean = mean(nchar(text)),
    Median = median(nchar(text)),
    Q3 = quantile(nchar(text), .75),
    Max = max(nchar(text))
  )

df %>%
  mutate(nword = str_count(text, "\\w+")) %>%
  summarize(
    Min = min(nword),
    Q1 = quantile(nword, .25),
    Mean = mean(nword),
    Median = median(nword),
    Q3 = quantile(nword, .75),
    Max = max(nword)
  )

# Frequencies
p.frequency <- map(c("SecondaryIsNA", "County"), ~ {
  df %>%
    ggplot(aes(nchar(text), fill = as.factor(.data[[.x]]))) +
    geom_histogram(binwidth = 1, alpha = 0.8) +
    labs(
      x = "Number of characters per text",
      y = "Number of texts"
    ) +
    theme_minimal()
})

texts <- as_tibble(df) %>%
  mutate(document = row_number()) %>%
  select(text)

tidy_texts <- texts %>%
  unnest_tokens(word, text) %>%
  group_by(word) %>%
  filter(n() > 10) %>%
  ungroup()

# Remove stop words
stopword <- as_tibble(stopwords::stopwords("en"))
stopword <- rename(stopword, word = value)
tb <- anti_join(tidy_texts, stopword, by = "word")

# Frequencies
tb %>%
  count(word, sort = TRUE) %>%
  filter(n > 2000) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  scale_y_continuous(expand = c(0, 0)) +
  coord_flip() +
  theme_classic(base_size = 12) +
  labs(title = "Word frequency", subtitle = "n > 100") +
  theme(plot.title = element_text(lineheight = .8, face = "bold")) +
  scale_fill_brewer()

# Word cloud
tb %>%
  count(word) %>%
  with(wordcloud(word, n, max.words = 15))

# Bigrams
bigrams <- texts %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

bigrams_count <- bigrams %>%
  count(bigram, sort = TRUE)

# seperate words
bigrams_separated <- bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ")

# filter stop words and NA
bigrams_filtered <- bigrams_separated %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word) %>%
  filter(!is.na(word1))

# new bigram counts:
bigram_counts <- bigrams_filtered %>%
  count(word1, word2, sort = TRUE)

# Networks
p_load(igraph, ggraph)

# filter for only relatively common combinations
bigram_graph <- bigram_counts %>%
  filter(n > 1000) %>%
  graph_from_data_frame()

ggraph(bigram_graph, layout = "fr") +
  geom_edge_link() +
  geom_node_point() +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1)

a <- grid::arrow(type = "closed", length = unit(.15, "inches"))

ggraph(bigram_graph, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n),
    show.legend = FALSE,
    arrow = a, end_cap = circle(.07, "inches")
  ) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

df.long <- df %>% pivot_longer(
  cols = 13:34
)

#Frequency plots
ggplot(
  data = df.long %>% filter(value == 1) %>%
    filter(!name %in% c("Dextromethorphan", "Opioid", "Xanax", "Others", "Flualprazolam")) %>%
    mutate(name = ifelse(name == "Prescription.opioids", "Prescription opioids", name)),
  aes(x = reorder(name, name, function(x) -length(x)))
) +
  geom_bar(stat = "count", position = position_dodge(), fill = "navy blue") +
  geom_text(stat = "count", aes(label = ..count..), vjust = -0.5) +
  scale_y_continuous(limits = c(0, 6500)) +
  labs(x = "Substance", y = "Count") +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, size = 14, hjust = 1),
    legend.position = "none"
  )
ggsave("Plots/fig 2.tiff", height = 8, width = 10, dpi = 300)

# How many are all negative
ggplot(
  data = df %>% group_by(`Number of substances`) %>% count() %>% uncount(n),
  aes(x = as.factor(`Number of substances`), fill = `Number of substances`)
) +
  geom_bar(stat = "count", position = position_dodge()) +
  geom_text(stat = "count", aes(label = ..count..), vjust = -0.5) +
  scale_y_continuous(limits = c(0, 27000), breaks = c(0, 5000, 10000, 15000, 20000, 25000)) +
  labs(x = "Number of Substance(s) Classified", y = "Count") +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 0, size = 14, hjust = 0.5),
    legend.position = "none"
  )

# Co-occurence table
df.cross <- as.data.frame(
  crossprod(
    as.matrix(df[, c(
      "Heroin", "Fentanyl", "Prescription.opioids",
      "Methamphetamine", "Cocaine", "Benzodiazepines", "Alcohol", "Others"
    )] == 1)
  )
)

flextable(df.cross %>% rownames_to_column()) %>%
  set_caption(caption = "Supplementary Table. Co-occurrence of substances involved in overdose deaths") %>%
  autofit() %>%
  theme_zebra(odd_header = "transparent", even_header = "transparent")


# Get stats by category for the AERONET-Radiosonde validation
run_category_stats_ar <- function()
{
  mlist.ar.post2007 <- lapply(mlist.ar, get_post_2007)

  r.post2007 <- calculate_category_stats_ar(mlist.ar.post2007)
  r.all <- calculate_category_stats_ar(mlist.ar)

  dateranges <- list(All = 1, Post2007 = 2)
  r.all$daterange <- 1
  r.post2007$daterange <- 2

  r <- rbind(r.all, r.post2007)
  r$daterange <- factor(r$daterange, labels=c('All', 'Post2007'))

  return(r)
}


#load text matrix file
text_matrix <- read.csv(file="C:\\Users\\Afan\\Desktop\\DIA\\text_matrix.csv",header = FALSE, sep = ',')
text_matrix <- as.matrix(text_matrix)
print(text_matrix)


#' Feature extraction: percentage of missing values by column
#'
#' A good quality of 3d scans is crucial for an assessment of similarity of
#' striation marks between different bullets.
#' Here, we measure the percentage of missing values in the scan. Generally,
#' a higher percentage of missing values is associated with a lower scan quality.
#' @param x3p scan in x3p format
#' @return percentage of missing values in each column of the scan's surface matrix
#' @export
#' @examples
#' data(fau277_bb_l2)
#' nas_bad <- extract_na_column(fau277_bb_l2)
#' plot(nas_bad) # the 'feathering' becomes obvious in the spikes of the missing values
#'
#' nas_good <- extract_na_column(fau001_ba_l1) # good scan
#' plot((1:length(nas_good))*3, nas_good, col =2)
#' points(nas_bad, col=4)
extract_na_column <- function(x3p) {
  stopifnot(class(x3p) == "x3p")

  dims <- dim(x3p$surface.matrix)
  # row sum will provide a summary of each column in the scan matrix (transposed values)
  nas <- rowSums(is.na(x3p$surface.matrix))

  return(nas/dims[2]*100)
}

#' Feature extraction: percentage of missing values by row
#'
#' A good quality of 3d scans is crucial for an assessment of similarity of
#' striation marks between different bullets.
#' Here, we measure the percentage of missing values in the scan. Generally,
#' a higher percentage of missing values is associated with a lower scan quality.
#' @param x3p scan in x3p format
#' @return percentage of missing values in each row of the scan's surface matrix
#' @export
#' @examples
#' data(fau277_bb_l2) # bad scan
#' nas_bad <- extract_na_row(fau277_bb_l2)
#' plot(nas_bad)
#' # interesting pattern: we would expect a similar pattern for all scans
#' # (going from very low percentage of missing values at the top of a scan to a
#' # fairly high percentage along the bottom)
#'
#' nas_good <- extract_na_row(fau001_ba_l1) # excellent scan
#' plot(nas_good) # similar pattern to above, but low values for most of the scan
extract_na_row <- function(x3p) {
  stopifnot(class(x3p) == "x3p")

    dims <- dim(x3p$surface.matrix)
  # row sum will provide a summary of each column in the scan matrix (transposed values)
  nas <- colSums(is.na(x3p$surface.matrix))

  return(nas/dims[1]*100)
}


#
# Don't complain; just work harder! Dan Stanford
#
# Our responsibility is to do what we can, learn what we can, improve the solutions, and pass them on. RF
#
# @author: me@andreagirardi.it
# @since: Sat Jan 25 19:36:21 CET 2020
# @project: RExercises
# @module: ggplot2 samples
# @desc:
#
# @prerequisite
#   library(ggplot)
#   mtcars

> install.package('dplyr')
> library(dplyr)

> install.packages("devtools")
> library(devtools)
> install_github("quantide/mapIT")

> df2015 <-read.csv(file = 'ElezReg2015/veneto.csv', header=TRUE, sep=';')
> df2015_verona <- filter(df2015, CIRCREGIONALE == 'VERONA')
> df2015_verona_zaia <- select(filter(df2015, CIRCREGIONALE == 'VERONA', LISTACIRC %in% c('LEGA NORD','ZAIA')), COMUNE, COGNOME, NOME, PREFERENZE)

> filter(df2015_verona_lnlz, COMUNE == 'MINERBE')
> valbusa <- filter(df2015_verona_lnlz, COGNOME == 'VALBUSA')

# Compare two candidates
> compare <- select(filter(df2015_verona_lnlz, COGNOME %in% c('MONTAGNOLI', 'VALBUSA')), COGNOME, COMUNE, PREFERENZE)

> ggplot(compare, aes(x = PREFERENZE, group = COMUNE, fill = COMUNE)) + geom_histogram()


# Merge the original validation data with extracted parameters for model input
library(raster); source("utils/set-temp-path.r")
source("utils/load-data.r")

# Original data
samples = read.csv("../data/groundtruth.csv")
coordinates(samples) = ~X+Y
row.names(samples) = samples$pkuid
samples$pkuid = NULL
projection(samples) = "+proj=longlat +datum=WGS84 +no_defs"
str(samples)

# Add "hardened" column: dominant land cover class
samples$dominant = factor(apply(samples@data, 1, which.max), labels = colnames(samples@data)[1:9], ordered = FALSE)
# Add a column that identifies endmembers
samples$pure = apply(samples@data[,1:9], 1, max) >= 95

# Extract data from rasters
rasters = LoadTrainingRasters()
# Should be scaled, but actually doesn't have any effect aside from taking up more space by being floats
#rasters$composite.1 = rasters$composite.1 / 2000
#rasters$composite.2 = rasters$composite.2 / 2000
#rasters$composite.3 = rasters$composite.3 / 2000
#rasters$composite.4 = rasters$composite.4 / 2000
data = extract(rasters, samples, method="simple", cellnumbers=TRUE, sp=TRUE)
anyNA(data@data)

# Give nice names and units
names(data) = c(names(samples), "cell.no", TrainingNames)

# Save it
write.csv(data, "../data/variables.csv")

# Get a reduced raster for SpatialPixelsDataFrame
pixels = raster::mask(rasters, samples, filename="../../userdata/indices-no-na/pixels.tif",
    overwrite=TRUE, progress="text", datatype="FLT4S")

# Data exploration
#cor(data@data[names(data) != "dominant"])
# Correlations are logical. OSAVI and NDVI are too correlated, and red and blue are quite close too.
#hist(data@data[,"water"]) # Base data is often zero-inflated
#hist(data@data[,"cell.no"]) # Not biased
#hist(data@data[,"red"]) # Lognormal
#hist(data@data[,"nir"]) # Bimodal normal
#hist(data@data[,"swir"]) # Bimodal normal
#hist(data@data[,"ndvi"]) # Reversed lognormal
#hist(data@data[,"lswi"]) # Normal
#hist(data@data[,"height"]) # Zero-inflated normal
#hist(data@data[,"slope"]) # Lognormal
#hist(data@data[,"aspect"]) # Pi-inflated uniform
#hist(data@data[,"tpi"]) # Normal


library(rhdf5)
library(qvalue)
library(dplyr)
#################

baseFolder <- "C:/OnlineFolders/BitSync/Current_Work/EBI_HipSci/Trans_iPSC/Expression/FeatureCounts_Genes/PEER/TestOptimal_N_Factors/"
subFolderBase <- "OutMappingPeerFactors."
chrSpecific = F
range <- 2:101
writeGlobalSig = T
writeGeneSig = F
threshold = 0.05
#multipleTestingGlobal = "BF"
multipleTestingGlobal = "ST"
topFeaturesOnly = FALSE

####
setwd(baseFolder)
results <- NULL
for(i in range){
  if(chrSpecific){
    tmp <- h5dump(file = paste(subFolderBase,i,"/qtl_results_",i,".h5",sep=""),)
  } else {
    #tmp <- h5dump(file = paste(subFolderBase,i,"/qtl_results_all.h5",sep=""),)
    tmp <- h5dump(file = paste(subFolderBase,i,"/qtl_results_2.h5",sep=""),)
  }
  for (j in names(tmp)) tmp[[j]][["feature"]] <- j
  df <- bind_rows(tmp)
  colnames(df)[which(colnames(df)=="corr_p_value")] <- "feature_corr_p_value"
  if(topFeaturesOnly){
    df <- df[match(unique(df$feature), df$feature),]
  }
  if(multipleTestingGlobal=="ST"){
    df["global_corr_p_value"] <- qvalue(df$feature_corr_p_value)$qvalues
  } else if (multipleTestingGlobal=="BF"){
    df["global_corr_p_value"] <- df$feature_corr_p_value*length(unique(df$feature))
    df$global_corr_p_value[df$global_corr_p_value>1]<-1
  }

  df <- df[order(df$global_corr_p_value,decreasing = F),]

  if(writeGlobalSig){
    print(paste(length(which(df$global_corr_p_value<threshold))," SNPs have a genetic effect on Factor: ",i,sep=""))
    write.table(paste(baseFolder,"results_global_level_",i,"_",threshold,".txt",sep=""),x = df[df$global_corr_p_value<threshold,],sep="\t",row.names=F,quote=F)
  }

  if(writeGeneSig){
    print(paste(length(which(df$gene_corr_p_value<threshold))," SNPs have a genetic effect on Factor: ",i," after correction",sep=""))
    write.table(paste(baseFolder,"results_gene_level_",i,"_",threshold,".txt",sep=""),x = df[df$gene_corr_p_value<threshold,],sep="\t",row.names=F,quote=F)
  }

}

#Count number of affected genes.
affectedFeatures <- NULL
posMainEffects <- NULL
negMainEffects <- NULL
oppositeEffectsVsMain <- NULL
sharedEffectsVsMain <- NULL
for(i in range){
  tmp <- read.delim(paste(baseFolder,"results_global_level_",i,"_",threshold,".txt",sep=""),as.is=T)
  tmp["sign"] <- "+"
  tmp["key"] <- paste(tmp$feature,tmp$snp_id,sep="-")
  tmp$sign[tmp$beta<0] <- "-"
  tmp$sign[tmp$beta<0] <- "-"
  if(is.null(posMainEffects) || is.null(negMainEffects)){
    tmp.first <- tmp[match(unique(tmp$feature), tmp$feature),]
    posMainEffects = tmp.first$key[which(tmp.first$sign=="+")]
    negMainEffects = tmp.first$key[which(tmp.first$sign=="-")]
  }

  affectedFeatures <- c(affectedFeatures,length(unique(tmp$feature)))
  sharedEffectsVsMain <- c(sharedEffectsVsMain,sum(tmp$key[which(tmp$sign=="-")]%in%negMainEffects) + sum(tmp$key[which(tmp$sign=="+")]%in%posMainEffects))
  oppositeEffectsVsMain <- c(oppositeEffectsVsMain,sum(tmp$key[which(tmp$sign=="+")]%in%negMainEffects) + sum(tmp$key[which(tmp$sign=="-")]%in%posMainEffects))
}
plot(affectedFeatures)
#points(sharedEffectsVsMain)
plot(sharedEffectsVsMain)
plot(oppositeEffectsVsMain)
plot(sharedEffectsVsMain,oppositeEffectsVsMain)
plot(sharedEffectsVsMain,affectedFeatures)

interestMax = which(affectedFeatures == max(affectedFeatures))
#Picked 40 PEER Factors, no factors skipped.


library(reshape2)
library(cowplot)
rm(list=ls())

data <- read.table("untitled.txt", sep = "\t" , header = TRUE , stringsAsFactors = FALSE)
colnames(data) <- trimws(gsub("\\."," ",sub("X\\.","",colnames(data))))
data <- data[data$Time < 1.5,]
for(i in 2:ncol(data)){
  data[,i] <- data[,i]/max(data[,i])
}
data <- melt(data, id.vars = "Time")

p5a <- ggplot(data[data$variable %in% "cycA",] , aes(x= Time , y = value))+
  geom_line(color="#FA0700")+scale_x_continuous(limits = c(0,1.1)) + theme_bw() +
  labs(y="Cyclin A2",x="")+
  theme(panel.grid = element_blank())

p5b <- ggplot(data[data$variable %in% "cycB",] , aes(x= Time , y = value))+
  geom_line(color="#0100FB")+scale_x_continuous(limits = c(0,1.1)) + theme_bw() +
  labs(y="Cyclin B1",x="")+
  theme(panel.grid = element_blank())

p5c <- ggplot(data[data$variable %in% "actCycB",] , aes(x= Time , y = value))+
  geom_line(color="#21A319")+scale_x_continuous(limits = c(0,1.1)) + theme_bw() +
  labs(y="actCycB",x="")+
  theme(panel.grid = element_blank())

p5d <- ggplot(data[data$variable %in% "cycA",] , aes(x= Time , y = value))+
  geom_line(color="#FA0700")+ scale_y_continuous(limits = c(0,0.4)) +
  scale_x_continuous(limits = c(0.1,0.6), breaks = c(0.1,0.45)) + theme_bw() +
  labs(y="Cyclin A2",x="")+
  theme(panel.grid = element_blank())

p5e <- ggplot(data[data$variable %in% "cycB",] , aes(x= Time , y = value))+
  geom_line(color="#0100FB")+ scale_y_continuous(limits = c(0,0.3)) +
  scale_x_continuous(limits = c(0.1,0.6), breaks = c(0.1,0.45)) + theme_bw() +
  labs(y="Cyclin B1",x="")+
  theme(panel.grid = element_blank())

p5f <- ggplot(data[data$variable %in% c("cycA","cycB","actCycB"),] , aes(x= Time , y = value , color = variable))+
  geom_line()+scale_x_continuous(limits = c(1.03,1.07)) + theme_bw() +
  labs(y="Expression",x="")+
  theme(panel.grid = element_blank(),
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) + guides(color=FALSE) +
  scale_color_manual(
    values = c(cycA="#FA0700",
               cycB="#0100FB",
               actCycB="#21A319"))

plot_grid(p5a,p5b,p5c,p5d,p5e,p5f,
          ncol = 3,
          labels = c("A","B","C","D","E","F"))


#Assign taxonomy using dada2 in parallel.
#This script assumesyou have a taxonomy table where:
#1. the row names are sample names.
#2. the column names are the actual unique sequences.
#clear environment, source paths.
rm(list=ls())
source('paths.r')
source('NEFI_functions/tic_toc.r')
library(doParallel)

#specify output path for taxonomic table here.
tax_output_path <- bahram_dada2_tax_table.path

#Here i load an OTU table with column names as unique sequences to assign.
otu <- readRDS(bahram_dada2_SV_table.path)
#Rarefy OTU table.----
# set.seed(5) # so that rarefaction is repeatable.
# otu_rare <- otu[rowSums(otu) >= 5000,]
# otu_rare <- vegan::rrarefy(otu_rare, 5000)
# # save rarefied otu table
# saveRDS(otu_rare, bahram_dada2_SV_table_rare_not_subset.path)

to_assign <- colnames(otu) #grab sequences to assign.

#Everything from here below *should* just run and save where you told it to.

greengenes.path <- paste0(data.dir,'gg_13_8_train_set_97.fa')
if(file.exists(greengenes.path)) {
cat('using previously downloaded green genes database.')
} else {

#download greengenes reference database.
cat('downloading green genes...\n')
gg.download.link <- 'https://zenodo.org/record/158955/files/gg_13_8_train_set_97.fa.gz?download=1'
cmd <- paste0('curl ',gg.download.link,' > ',greengenes.path)
system(cmd)
cat('greengenes download complete.\n')
}

#assign taxonomy.
tic()
cat('Assigning taxonomy using the RDP Classifier...\n')
out <- dada2::assignTaxonomy(to_assign,greengenes.path,multithread = T, tryRC=T)
cat('Taxonomy assignment complete. ')
toc()

#how many cores to run on and therefore how many subsets to break taxonomy string into.
#n <- detectCores()
#registerDoParallel(cores=n)

#set breakpoints for subsetting taxonomy list.
#to_assign <- colnames(otu)
#brk <- round(length(to_assign) / n)

#use a foreach loop to do this in parallel on subsets.
#tic()
#cat('assigning taxonomy with the RDP classifier and greengenes training set...\n')
#output.list <-
#  foreach(i = 1:n) %dopar% {
#    #tell loop where i of n taxonomy subset starts and ends.
#    start <- (brk*i - brk) + 1
#    end <- brk*i
    #if you on the last subset go to end.
#    if(i == n){end = length(to_assign)}

    #assign taxa
#    tax.out <- dada2::assignTaxonomy(to_assign[start:end],greengenes.path)

    #return output to list
#    return(tax.out)
#  }
#cat('Taxonomy assignment complete! yeahhhh.\n')
#toc()

#merge together output of parallel assignment.
#out <- data.frame(do.call('rbind',output.list))

#save output as your taxonomy file.
saveRDS(out, tax_output_path)


library(cummeRbund)

args = commandArgs(trailingOnly=TRUE)

setwd(args[1])

cuff = readCufflinks(args[2])

samples = strsplit(args[3], ",", fixed = TRUE)[[1]]
samples = gsub("-","_",samples)
strain = strsplit(args[2], "/", fixed=TRUE)[[1]]
strain = strain[length(strain)]

t1 = paste(strain, "_T1", sep="")
if (! t1 %in% samples) { ## Hack for bad names in old runs
    t1 = paste(strain, "_TP1", sep="")
}
noab = paste(strain, "_NoAb", sep="")
samples = samples[!is.element(samples,c(t1,noab))]
t1 = paste("X", t1, sep="")
noab = paste("X", noab, sep="")
for (i in 1:length(samples)) {samples[i] = paste("X",samples[i],sep="")}

write.table(replicates(cuff), "replicates.csv", sep=",", quote=F)
write.table(annotation(genes(cuff)), "annotations.csv", sep=",", quote=F)
write.table(fpkm(genes(cuff)), "fpkm-genes.csv", sep=",", quote=F)
write.table(repFpkm(genes(cuff)), "repFpkm-genes.csv", sep=",", quote=F)
write.table(count(genes(cuff)), "count-genes.csv", sep=",", quote=F)
write.table(fpkm(isoforms(cuff)), "repFpkm-genes.csv", sep=",", quote=F)
write.table(diffData(genes(cuff)), "diffData-genes.csv", sep=",", quote=F)
##write.table(, "repFpkm-genes.csv", sep=",", quote=F)
##write.table(, "repFpkm-genes.csv", sep=",", quote=F)

csDensity(genes(cuff))
dispersionPlot(genes(cuff))
fpkmSCVPlot(genes(cuff))
fpkmSCVPlot(isoforms(cuff))
csBoxplot(genes(cuff))
csDendro(genes(cuff))

csScatterMatrix(genes(cuff))
csVolcanoMatrix(genes(cuff))
sigMatrix(cuff,level='genes',alpha=0.05)
PCAplot(genes(cuff),"PC1","PC2")
csDistHeat(genes(cuff))

pdf(file="scatter-pairs.pdf")
for (x in c(t1,noab)) {
    plot_list = list()
    for (i in 1:length(samples)) {
        plot_list[[i]] = csScatter(genes(cuff),
                                   samples[i], x, smooth=T)
    }
    for (i in 1:length(samples)) {
        print(plot_list[[i]])
    }
}
dev.off()

pdf(file="maplot-pairs.pdf")
for (x in c(t1,noab)) {
    plot_list = list()
    for (i in 1:length(samples)) {
        plot_list[[i]] = MAplot(genes(cuff),
                                samples[i], x, smooth=T)
    }
    for (i in 1:length(samples)) {
        print(plot_list[[i]])
    }
}
dev.off()

pdf(file="volcano-pairs.pdf")
for (x in c(t1,noab)) {
    plot_list = list()
    for (i in 1:length(samples)) {
        plot_list[[i]] = csVolcano(genes(cuff),
                                samples[i], x, smooth=T)
    }
    for (i in 1:length(samples)) {
        print(plot_list[[i]])
    }
}
dev.off()

gene_diff_data=diffData(genes(cuff))
sig_gene_data = subset(gene_diff_data,significant=='yes')
sig_genes = getGenes(cuff,sig_gene_data$gene_id)

write.table(sig_gene_data,'sig-diff-genes.csv',sep=',',quote=F)

pdf(file="expression-barplot.pdf")
lclsigs = getSig(cuff,alpha=0.05,level='genes')[1:10]
expressionBarplot(getGenes(cuff,lclsigs),logMode=T,showErrorbars=T)
dev.off()

pdf(file="expression-heatmap.pdf")
lclsigs = getSig(cuff,alpha=0.05,level='genes')[1:10]
csHeatmap(getGenes(cuff,lclsigs),cluster='both')
dev.off()


filter_argot2 <- function(in_file,out_file){
    print("Reading the input file")
    argot2_data = fread(in_file)
    tmp = gsub("_P[0-9]+","",argot2_data$Sequence)
    tmp = gsub("FGP","FG",tmp,fixed = T)
    tmp

    gaf_cols=fread("../gaf_cols.txt",header = F)$V1
    gaf_cols

    print("Converting to GAF 2.0")
    gaf_data = argot2_data[,.(Sequence,`GO ID`,`Internal Confidence`,Aspect)]
    colnames(gaf_data) = c("db_object_id","term_accession","with","aspect")

    gaf_data$with = as.numeric(with)
    min_score=min(gaf_data$with)
    max_score=max(gaf_data$with)
    gaf_data$with = (gaf_data$with - min_score)/(max_score - min_score)

    gaf_data[,db_object_id:=tmp]
    gaf_data[,db_object_symbol:=tmp]
    gaf_data[,db:="maize-GAMER"]
    gaf_data[,qualifier:=0]
    gaf_data[,db_reference:="MG:0000"]
    gaf_data[,evidence_code:="IEA"]
    gaf_data[,db_object_name:=""]
    gaf_data[,db_object_synonym:=""]
    gaf_data[,db_object_type:="protein"]
    gaf_data[,taxon:="taxon:4577"]
    gaf_data[,date:="03272017"]
    gaf_data[,assigned_by:="Argot2"]
    gaf_data[,annotation_extension:=""]
    gaf_data[,gene_product_form_id:=""]
    setcolorder(gaf_data,gaf_cols)

    print("Writing the outfile")
    write_gaf(gaf_data,out_file)
}


#研究f_eject射出次数和频率
#分为single单次射出，即单脉冲内射出的次数
#还有eject，总体射出频率

#设定工作目录
setwd("D:/data")
library(xlsx)

#读取数据
k2 <- read.xlsx("f_eject.xls", sheetName = "single_k2", header = TRUE)
k3 <- read.xlsx("f_eject.xls", sheetName = "single_k3", header = TRUE)
k4 <- read.xlsx("f_eject.xls", sheetName = "single_k4", header = TRUE)
k5 <- read.xlsx("f_eject.xls", sheetName = "single_k5", header = TRUE)

#设置画图区间
par(mfrow = c(2,2), mar = c(4,4,2,2), oma = c(2,2,2,2))

#保存数据
#pdf("f_k_mixed.pdf")

##################################画图--占空比k为0.2#######################
plot(k2$fv, k2$X1.5, xaxs = "i", col = 0, xlab = "Voltage frequency (Hz)", ylab = "Frequency in cycle (Hz)", main = "Eject frequency in duty = 0.2", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 150), ylim = c(0, 110))

#model1 = loess(k2$X1.5 ~ k2$fv, span = 0.8 , degree = 2)
lines(k2$fv, k2$X1.5,  col="#458B74", lwd=2, type="l", lty=3)

#model2 = loess(k2$X27 ~ k2$fv, span = 0.8, degree = 2)
lines(k2$fv, k2$X27, col="#FF00FF", lwd=2, type="l", lty=3)

#model3 = loess(k2$X54 ~ k2$fv, span = 0.8, degree = 2)
lines(k2$fv, k2$X54, col="#EE0000", lwd=2, type="l", lty=3)

#model4 = loess(k2$X180 ~ k2$fv, span = 0.8, degree =2)
lines(k2$fv, k2$X180, col="#27408B", lwd=2, type="l", lty=3)

#区域划线
legend("topright", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, inset = .03, bty = "n")

##################################画图--占空比k为0.3#######################
plot(k3$fv, k3$X1.5, xaxs = "i", col = 0, xlab = "Voltage frequency (Hz)", ylab = "Frequency in cycle (Hz)", main = "Eject frequency in duty = 0.3", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 150), ylim = c(0, 100))

#model1 = loess(k3$X1.5 ~ k3$fv, span = 0.8 , degree = 2)
lines(k3$fv, k3$X1.5,  col="#458B74", lwd=2, type="l", lty=3)

#model2 = loess(k3$X27 ~ k3$fv, span = 0.8, degree = 2)
lines(k3$fv, k3$X27, col="#FF00FF", lwd=2, type="l", lty=3)

#model3 = loess(k3$X54 ~ k3$fv, span = 0.8, degree = 2)
lines(k3$fv, k3$X54, col="#EE0000", lwd=2, type="l", lty=3)

#model4 = loess(k3$X180 ~ k3$fv, span = 0.8, degree =2)
lines(k3$fv, k3$X180, col="#27408B", lwd=2, type="l", lty=3)

#区域划线
legend("topright", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, inset = .03, bty = "n")

##################################画图--占空比k为0.2#######################
plot(k4$fv, k4$X1.5, xaxs = "i", col = 0, xlab = "Voltage frequency (Hz)", ylab = "Frequency in cycle (Hz)", main = "Eject frequency in duty = 0.4", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 150), ylim = c(0, 172))

#model1 = loess(k4$X1.5 ~ k4$fv, span = 0.8 , degree = 2)
lines(k4$fv, k4$X1.5,  col="#458B74", lwd=2, type="l", lty=3)

#model2 = loess(k4$X27 ~ k4$fv, span = 0.8, degree = 2)
lines(k4$fv, k4$X27, col="#FF00FF", lwd=2, type="l", lty=3)

#model3 = loess(k4$X54 ~ k4$fv, span = 0.8, degree = 2)
lines(k4$fv, k4$X54, col="#EE0000", lwd=2, type="l", lty=3)

#model4 = loess(k4$X180 ~ k4$fv, span = 0.8, degree =2)
lines(k4$fv, k4$X180, col="#27408B", lwd=2, type="l", lty=3)

#区域划线
legend("topright", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, inset = .03, bty = "n")

##################################画图--占空比k为0.5#######################
plot(k5$fv, k5$X1.5, xaxs = "i", col = 0, xlab = "Voltage frequency (Hz)", ylab = "Frequency in cycle (Hz)", main = "Eject frequency in duty = 0.5", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 150), ylim = c(0, 110))

#model1 = loess(k5$X1.5 ~ k5$fv, span = 0.8 , degree = 2)
lines(k5$fv, k5$X1.5,  col="#458B74", lwd=2, type="l", lty=3)

#model2 = loess(k5$X27 ~ k5$fv, span = 0.8, degree = 2)
lines(k5$fv, k5$X27, col="#FF00FF", lwd=2, type="l", lty=3)

#model3 = loess(k5$X54 ~ k5$fv, span = 0.8, degree = 2)
lines(k5$fv, k5$X54, col="#EE0000", lwd=2, type="l", lty=3)

#model4 = loess(k5$X180 ~ k5$fv, span = 0.8, degree =2)
lines(k5$fv, k5$X180, col="#27408B", lwd=2, type="l", lty=3)

#区域划线
legend("topright", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, inset = .03, bty = "n")

#dev.off()


code 'sce_contrast_interest_accrual'
name '利息收入（权责发生制）对照'
dimensions {
	accbook null
	monthEnd name:'cfDate'
	scene null
}
layout {
	rows 'accbook'
	columns (['cfDate','scene'])
}
dataRequest {
	name 'scene1'
	table 'sceMcf',{
		allDimensions (['accbook','cfDate'])
	}
	fields 'accbook,cfDate,sum(interestAccrual) value'
    groupFields 'accbook,cfDate'
	contextParams (['scene1','foreignToHome'])
}
dataRequest {
	name 'scene2'
	table 'sceMcf',{
		allDimensions (['accbook','cfDate'])
	}
	fields 'accbook,cfDate,sum(interestAccrual) value'
    groupFields 'accbook,cfDate'
	contextParams (['scene2','foreignToHome'])
}
derivedHeads{
    accbook ([new Head(name:'净利息收入',aggregate:true,formula:{
        def grids=thisColGrids({parent==null})
        def a=grids.find{it.rowHeadGrid.model?.alType=='A'}
        def l=grids.find{it.rowHeadGrid.model?.alType=='L'}
        if(a && l){
            a-l
         }
    })])
}
dataGrids {
	apply selectRows({children!=null}),{
		formula {sumChildren()}
	}
	apply sel([scene:'scene2']),{
		params {
			dataRequest 'scene2'
		}
	}
}


library(tidyverse)

##############################################################################
# Experiment 1 data
da_exp <- read.csv("./outputs/simuls_nips/synth_da/scores.csv", nrows = 4, header = F)
for (ii in c(2, 3, 4, 1)){
  da_exp[ii,] <- da_exp[ii,] / da_exp[1,]
}
da_exp <- da_exp[2:4,] %>%
  gather(key = "estimator", value = "score")

estimator <- c("log-diag", "Wasserstein", "geometric") %>%
  factor(, levels = c("log-diag", "Wasserstein", "geometric"))
da_exp$estimator <- rep(estimator, times = 10)

distance <- read.csv("./outputs/simuls_nips/synth_da/distance_a.csv", header = F)
da_exp$xaxis <- rep(distance[["V1"]], each = 3)

color_cats <- c(
  "#009D79",# blueish green
  "#EEA535",  # orange
  "#E36C2F"  #vermillon
  # "#56B4E9",# sky blue
  # "#F0E442", #yellow
  # "#0072B2", #blue
  # "#CC79A7" #violet
)

ggplot(
  data = da_exp,
  mapping = aes(y = score, x = xaxis, group = estimator,
                color = estimator, fill = estimator)) +
  geom_hline(yintercept = 1., color = "black", linetype = "dotted",
             size = 1) +
  geom_line(size = 1.5, alpha = 0.8) +
  geom_point(fill = "white", size = 3, shape = 21) +
    theme_minimal() +
  scale_x_continuous(breaks = seq(0, 3, 0.5)) +
  scale_y_continuous(limits = c(0, 1.05)) +
  scale_color_manual(values = color_cats, name = NULL) +
  scale_fill_manual(values = color_cats, name = NULL) +
  annotate(geom = "text", x = 0.35, y = 1.04, label = "chance level") +
  labs(x = expression(mu),
       y = "Normalized MAE") +
  theme(text = element_text(family = "Helvetica", size = 16),
        legend.position = "top", legend.title = element_text(size = 14))
ggsave("./outputs/fig_1a_distance.png", width = 5, height = 3.5, dpi = 300)
ggsave("./outputs/fig_1a_distance.pdf", width = 5, height = 3.5, dpi = 300)

##############################################################################
# Experiment 2 data

snr_exp <- read.csv("./outputs/simuls_nips/synth_snr/scores.csv", nrows = 4, header = F)
for (ii in c(2, 3, 4, 1)){
  snr_exp[ii,] <- snr_exp[ii,] / snr_exp[1,]
}

snr_exp <- snr_exp %>%
  gather(key = "estimator", value = "score")

estimator2 <- c("chance", "log-diag", "Wasserstein", "geometric") %>%
  factor(, levels = c("chance", "log-diag", "Wasserstein", "geometric"))

snr_exp$estimator <- rep(estimator2, times = 10)

sigmas <- read.csv("./outputs/simuls_nips/synth_snr/sigmas.csv", header = F)
snr_exp$xaxis <- rep(sigmas[["V1"]], each = 4)

ggplot(
  data = snr_exp %>% subset(estimator != "chance"),
  mapping = aes(y = score, x = xaxis, group = estimator,
                color = estimator)) +
  geom_line(size = 1.5, alpha = 0.8) +
  geom_point(fill = "white", size = 3, shape = 21) +
  theme_minimal() +
  scale_y_continuous(limits = c(0, 1.05)) +
  scale_x_log10(breaks =  10^(-10:10),
                minor_breaks = rep(1:9, 21) * (10 ^ rep(-10:10, each=9))) +
  scale_color_manual(values = color_cats, name = NULL) +
  # labs(x = TeX("distance between A and $I_p$"),
  #      y = "normalized M.A.E.") +
  geom_hline(yintercept = 1, color = "black", linetype = "dotted",
             size = 1) +
  annotate(geom = "text", x = 0.02, y = 1.04, label = "chance level") +
  labs(x = expression(sigma),
       y = "Normalized MAE") +
  theme(text = element_text(family = "Helvetica", size = 16),
        legend.position = "top", legend.title = element_text(size = 14))
ggsave("./outputs/fig_1b_snr.png", width = 5, height = 3.5, dpi = 300)
ggsave("./outputs/fig_1b_snr.pdf", width = 5, height = 3.5, dpi = 300)


include  defs

# caslab - get one case label

integer function caslab (n, t)

integer n, t
character tok(MAXTOK)
integer i, s, lev
integer gnbtok, ctoi

	t = gnbtok (tok, MAXTOK)
	while (t == NEWLINE)
	    t = gnbtok (tok, MAXTOK)

	if (t == EOF)
	    return (t)

	for (lev=0;  t == LPAREN;  t = gnbtok (tok, MAXTOK))
	    lev = lev + 1

	if (t == MINUS)
	    s = -1
	else
	    s = +1
	if (t == MINUS | t == PLUS)
	    t = gnbtok (tok, MAXTOK)

	if (t != DIGIT)
	    goto 99
	else {
	    i = 1
	    n = s * ctoi (tok, i)
	}

	for (t=gnbtok(tok,MAXTOK);  t == RPAREN;  t=gnbtok(tok,MAXTOK))
	    lev = lev - 1
	if (lev != 0)
	    goto 99

	while (t == NEWLINE)
	    t = gnbtok (tok, MAXTOK)

	return 0

 99	call synerr ("Invalid case label.")
	n = 0
end


library(GenomicRanges)
library(rtracklayer)

#20180525_modification: See commented out code with Views(). Upgrading to R version 5.0 will cause RangesList to become deprecated and GRangesList is not compatible with this function. In order to circumvent, a newer updated version of splitting a GRanges into GRangesList was added.
#20180625_modification: added check_chromosome_boundary function in order to determine which peaks interfere with the chromosome boundaries of the assemblies you want to obtain a metapeak from. This will help you with exo_metapeak_matrix function errors.

apply_seqlengths <- function(gr, genome=Mmusculus) {
  seqlengths(gr) <- seqlengths(genome)[seqlevels(gr)]
  gr
}

check_coverage_argument <- function(cvg, regions=NULL) {
  if(class(cvg) == "character") {
    if(is.null(regions)) {
      cvg <- import(cvg, as="RleList")
    } else {
      stopifnot(file.exists(cvg))
      cvg <- import(cvg, which=regions, as="RleList")
    }
  }
  cvg
}

regionApply <- function(regions, cvg, func, ...) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(unlist(
           viewApply(
             #Views(cvg, as(regions, "GRangesList")),
             Views(cvg, split(regions, seqnames(regions))),
             function(x) { func(as.numeric(x)) },
             simplify=FALSE
           ), use.names=FALSE), use.names=FALSE)
  ans
}

regionApply_list <- function(regions, cvg, func) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
           viewApply(
             #Views(cvg, as(regions, "GRangesList")),
             Views(cvg, split(regions, seqnames(regions))),
             function(x) { func(as.numeric(x)) },
             simplify=FALSE
           ), use.names=FALSE)
  ans
}

regionSums <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
           viewSums(
             #Views(cvg, as(regions, "GRangesList"))
             Views(cvg, split(regions, seqnames(regions)))
           ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionMeans <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
           viewMeans(
             #Views(cvg, as(regions, "GRangesList"))
             Views(cvg, split(regions, seqnames(regions)))
           ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionWhichMaxs <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
           viewWhichMaxs(
             #Views(cvg, as(regions, "GRangesList"))
             Views(cvg, split(regions, seqnames(regions)))
           ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionWhichMins <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
    viewWhichMins(
      #Views(cvg, as(regions, "GRangesList"))
      Views(cvg, split(regions, seqnames(regions)))
    ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionMaxs <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
           viewMaxs(
             #Views(cvg, as(regions, "GRangesList"))
             Views(cvg, split(regions, seqnames(regions)))
           ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

regionMins <- function(regions, cvg) {
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(
           viewMins(
             #Views(cvg, as(regions, "GRangesList"))
             Views(cvg, split(regions, seqnames(regions)))
           ), use.names=FALSE)
  ans[oo] <- ans  # restore original order
  ans
}

total_signal <- function(cov) {
  if(class(cov) == "character") {
    cache.file <- paste0(cov, ".ts.rds")
    if(file.exists(cache.file)) {
      return(readRDS(cache.file))
    } else {
      cov <- check_coverage_argument(cov)
      ts <- sum(as.numeric(sapply(cov, function(x) sum(as.numeric(x)))))
      saveRDS(ts, file=cache.file)
      return(ts)
    }
  } else {
    return(sum(as.numeric(sapply(cov, function(x) sum(as.numeric(x))))))
  }
}

nexus_regionSums <- function(gr, sample){
  signal <- regionSums(gr, sample$pos) + abs(regionSums(gr, sample$neg))
  signal
}

#FXN: Check Chromosome Boundaries

#Inputs: (1) gr=regions of interest for exo_metapeak_matrix, (2) genome=genome assembly that the data is aligned to, (3) resize_boundary=the extensions created by the "downstream" input command and "upstream" input command on exo_metapeak_matrix.

#Outputs: Returns an vector of indices that oversteps the designated chromosome boundaries and are therefore incompatible with matrix computation. Use indices WRT "gr" input.

#Example: Input: Granges called "example.ranges" of 100 regions from the dm6 genome that we want to plot +/- 500bp from the center.
#         Use Case: library(BSgenome.Dmelanogaster.UCSC.dm6)  <-call library of genome you want to check across
#                   bad_spots<-check_chromosome_boundaries(gr=example.ranges, genome=BSgenome.Dmelanogaster.UCSC.dm6, resize_boundary=1001) <-apply the function to find if you have any bad regions
#                   if(length(bad_spots>0){example.ranges<-example.ranges[-bad_spots]} <- IF the bad regions exist, remove them from your GRanges. ****Make sure to always wrap this in an IF statement. Calling a variable of length=0 as a negative will erase the entire contents of the variable.

check_chromosome_boundaries<-function(gr, genome, resize_boundary){
  #Scan and flag sites with "start" boundary surpassed
  start_surpass_indexes<-which(gr@ranges@start<=resize_boundary)

  #Scan and flag site with "end" boundary surpassed
  #Find genome lengths at chromosomes that are relevant
  genome.seqlengths<-c()
  for(i in 1:length(seqlevels(gr))){
    chrom_index<-which(seqnames(genome)==seqlevels(gr)[i])
    genome.seqlengths[i]<-seqlengths(genome)[chrom_index]
  }
  names(genome.seqlengths)<-seqlevels(gr)

  flagged_indexes<-matrix(data=NA, nrow = length(seqlevels(gr)), ncol =length(gr))
  #For each chromosome length, check granges for violations of boundaries.
  for(x in 1:length(seqlevels(gr))){
    #Subset the entire granges by this particular seqlevel
    for(y in 1:length(gr)){
      if((seqnames(gr)[y]==seqlevels(gr)[x])@values){
        #Check if subsetted granges at each element to be within the resize_boundary
        resize_value<-(gr[y]@ranges@start+gr[y]@ranges@width)+resize_boundary
        boundary<-genome.seqlengths[x]
        if(resize_value>=boundary){flagged_indexes[x,y]<-y}
      }
    }
  }
  flagged_indexes<-as.vector(flagged_indexes)
  flagged_indexes<-flagged_indexes[-which(is.na(flagged_indexes))]
  return(flagged_indexes)
}


#script to generate the pie chart for Fig. 4G
#update to barplot 2017-05-02

library(ggplot2)
library(extrafont)
library(RColorBrewer)
library(scales)

args <- commandArgs(trailingOnly = TRUE)

rhttable=args[1]
#pubtable=args[2]

rht=read.table(rhttable,sep="\t")

RdBu=brewer.pal(n=11,"RdBu")
RdBu16=colorRampPalette(RdBu)(16)
RdBu4=brewer.pal(n=4,"RdBu")

tstring=gsub(" .*$","",Sys.time(),perl=TRUE)
mononame=paste("mono-",tstring,".pdf",sep="")
diname=paste("di-",tstring,".pdf",sep="")
rhttabn=data.frame(rht,"RHT")
names(rhttabn)=c("base","value","Type","Experiment")
monorht=rhttabn[grepl(pattern="mono",rhttabn$Type,perl=T),]
dirht=rhttabn[grepl(pattern="di",rhttabn$Type,perl=T),]
monorhtn=monorht
dirhtn=dirht

dirhtn$base=gsub(pattern="T","U",dirhtn$base,perl=T)
monorhtn$base=gsub(pattern="T","U",monorhtn$base,perl=T)
dp=ggplot(dirhtn,aes(x="",y=value,fill=base))+geom_bar(width = 1,stat = "identity")+coord_polar(theta="y",start=pi/3.14)+scale_fill_manual(values = rev(RdBu16))+scale_x_discrete("")+scale_y_continuous("")+
  geom_text(aes(x=1.28,label = percent(dirhtn$value/sum(dirhtn$value))), size=4,position = position_stack(vjust = 0.5))+
  theme(text = element_text(family = "Arial Narrow"), plot.title=element_text(hjust = 0.5,size=14),axis.text=element_blank(),axis.title=element_text(size=14),axis.line=element_blank(),panel.background=element_blank(),legend.text=element_text(size=12),legend.background=element_blank(),legend.title=element_blank())+ggtitle("di-nucleotides")

mp=ggplot(monorhtn,aes(x="",y=value,fill=base))+geom_bar(width = 1,stat = "identity")+coord_polar("y",start=pi/3.14)+scale_fill_manual(values = rev(RdBu4))+scale_x_discrete("")+scale_y_continuous("Percent")+
  geom_text(aes(x=1.28,label = percent(monorhtn$value/sum(monorhtn$value))), size=4,position = position_stack(vjust = 0.5))+
  theme(text = element_text(family = "Arial Narrow"), plot.title=element_text(hjust = 0.5,size=14),axis.text=element_blank(),axis.title=element_text(size=14),axis.line=element_blank(),panel.background=element_blank(),legend.text=element_text(size=12),legend.background=element_blank(),legend.title=element_blank())+ggtitle("mono-nucleotide")

ggsave(plot=mp,height=12,width=12, filename=mononame, useDingbats=FALSE,units="cm")
ggsave(plot=dp,height=12,width=12, filename=diname, useDingbats=FALSE,units="cm")


coefOther <-function(ivmodel){
  if(ivmodel$p == 0) stop("There are no additional exogenous covariates!")

  coefList = list(); nameList = c()
  if(!is.null(ivmodel$kClass)){
    for(i in 1:length(ivmodel$kClass$k)) {
      temp = matrix(0,length(ivmodel$kClass$point.est.other[i,]),4)
      colnames(temp) = c("Estimate", "Std. Error", "t value", "Pr(>|t|)")
      temp[,1] = ivmodel$kClass$point.est.other[i,]
      temp[,2] = ivmodel$kClass$std.err.other[i,]
      temp[,3] = ivmodel$kClass$test.stat.other[i,]
      temp[,4] = ivmodel$kClass$p.value.other[i,]
      rownames(temp) = colnames(ivmodel$X)
      if(ivmodel$kClass$k[i] == 0) {
        nameList = c(nameList,"OLS")
      } else if(ivmodel$kClass$k[i] == 1) {
        nameList = (c(nameList,"TSLS"))
      } else {
        nameList = (c(nameList,ivmodel$kClass$k[i]))
      }
      coefList[[length(coefList) + 1]] = temp
    }
  }
  if(!is.null(ivmodel$LIML)){
    temp = matrix(0,length(ivmodel$LIML$point.est.other),4)
    colnames(temp) = c("Estimate", "Std. Error", "t value", "Pr(>|t|)")
    rownames(temp) = colnames(ivmodel$X)
    temp[,1] = ivmodel$LIML$point.est.other
    temp[,2] = ivmodel$LIML$std.err.other
    temp[,3] = ivmodel$LIML$test.stat.other
    temp[,4] = ivmodel$LIML$p.value.other
    coefList[[length(coefList) + 1]] = temp
    nameList = c(nameList,"LIML")
  }
  if(!is.null(ivmodel$Fuller)){
    temp = matrix(0,length(ivmodel$Fuller$point.est.other),4)
    colnames(temp) = c( "Estimate", "Std. Error", "t value", "Pr(>|t|)")
    rownames(temp) = colnames(ivmodel$X)
    temp[,1] = ivmodel$Fuller$point.est.other
    temp[,2] = ivmodel$Fuller$std.err.other
    temp[,3] = ivmodel$Fuller$test.stat.other
    temp[,4] = ivmodel$Fuller$p.value.other
    coefList[[length(coefList) + 1]] = temp
    nameList = c(nameList,"Fuller")
  }
  names(coefList) = nameList
  return(coefList)
}


#Start by import step in Starling2019.r
######################################################
#####Taxa bar plots, also see StarlingScript.rmd
####################################################
GPr  = transform_sample_counts(physeq, function(x) x / sum(x) ) #transform samples based on relative abundance
GPrPhylum=tax_glom(GPr,"Phylum")
PhylumLevel = filter_taxa(GPrPhylum, function(x) mean(x) > 1e-3, TRUE) #filter out any taxa lower tha 0.1%
#PhylumLevel  = transform_sample_counts(PhylumLevel, function(x) x / sum(x) )
GPrFamily=tax_glom(GPr,"Family")
FamilyLevel = filter_taxa(GPrFamily, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
#FamilyLevel  = transform_sample_counts(FamilyLevel, function(x) x / sum(x) )
GPrGenus=tax_glom(GPr,"Genus")
GenusLevel = filter_taxa(GPrGenus, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
GPrGenus=tax_glom(GPr,"Species")
SpeciesLevel = filter_taxa(GPrGenus, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
############Phylum level
sample_data(PhylumLevel)

###########################################################
##Percentages for top phyla across samples
##########################################################
df <- psmelt(PhylumLevel)
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Phylum"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N)
)
Trtdata
ggplot(Trtdata, aes(x=Phylum,y=mean))+geom_bar(aes(fill = Phylum),colour="black", stat="identity")+ facet_wrap(Sample_Type~Anti_Post)+xlab("Sample Type")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+ scale_fill_manual(values=cbPalette)+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)

df <- psmelt(FamilyLevel)
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Family"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N)
)
Trtdata

############################
#Antimortem communities
###########################
Antimortem=subset_samples(physeq, Anti_Post== "Antemortem")
Antimortem
ord=ordinate(,"PCoA", "wunifrac") #other common methods besides for weighted unifrac include jaccard, bray, jsd
ordplot=plot_ordination(Antimortem, ord,"samples", color="Sample.Type")+geom_point(size=4)+scale_colour_manual(values=cbPalette)+scale_fill_manual(values=cbPalette)
ordplot+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
   theme(legend.justification=c(1,0), legend.position=c(1,0))#+facet_wrap(~Anti_Post)+ stat_ellipse(type= "norm",geom = "polygon", alpha = 1/4, aes(fill = Anti_Post))

GPr  = transform_sample_counts(Antimortem, function(x) x / sum(x) ) #transform samples based on relative abundance
GPrPhylum=tax_glom(GPr,"Phylum")
PhylumLevel = filter_taxa(GPrPhylum, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 0.1%
#PhylumLevel  = transform_sample_counts(PhylumLevel, function(x) x / sum(x) )
GPrFamily=tax_glom(GPr,"Family")
FamilyLevel = filter_taxa(GPrFamily, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
#FamilyLevel  = transform_sample_counts(FamilyLevel, function(x) x / sum(x) )
GPrGenus=tax_glom(GPr,"Genus")
GenusLevel = filter_taxa(GPrGenus, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
GPrGenus=tax_glom(GPr,"Species")
SpeciesLevel = filter_taxa(GPrGenus, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
###############
#Alpha diversity
#################
#From Qiime outputs:
#Faith_PD_group_significance.qzv
#Shannon_group_significance.qzv

##Faceted graph of Antimortem only Phylum level
df <- psmelt(PhylumLevel)
sample_data(PhylumLevel)
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Phylum", "Sample_Type"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N)
)
Trtdata
labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
PhylumAntiFacetPlot=ggplot(Trtdata, aes(x=Sample_Type,y=mean))+geom_bar(aes(fill = Sample_Type),colour="black", stat="identity")+ facet_wrap(~Phylum)+xlab("Sample Type")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
   theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)+ scale_fill_manual(values=cbPalette)
PhylumAntiFacetPlot

Means=compare_means(Abundance ~ Hours, data = df, method = "kruskal.test",
                    group.by = "Phylum", p.adjust.method = "fdr")
head(Means)
keeps <- c("Phylum","group1","group2","p.format","p.adj","method","p.signif")
keeps=Means[keeps]
#keeps
test3 <- list('Phylum'= keeps$Phylum,'group1'=keeps$group1,'group2'= keeps$group2 ,'p'=keeps$p.format,'p.adj'=keeps$p.adj,p.signif=keeps$p.signif,'Method'=keeps$method)
test3= as.data.frame(test3)
test3
FilteredResults<-test3[!(test3$p.adj>0.5),]
FilteredResults

labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
cdataplot=ggplot(Trtdata, aes(x=Anti_Post,y=mean))+geom_bar(aes(fill = Phylum),colour="black", stat="identity")+ facet_grid(~Sample_Type, labeller=labeller(Sample_Type = labels))+xlab("Treatment")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  scale_x_discrete(labels=c("0 hrs", "24 hrs", "48 hrs","72 hrs"))+ theme(axis.text.x = element_text(angle = 45, hjust = 1))#+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)#+ scale_fill_manual(values=cbPalette)
cdataplot
#########################family level
FamilySampleType=subset_samples(FamilyLevel, Sample_Type =="Cloacal_Swab")
df <- psmelt(FamilySampleType) #FamilyLevel
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Family","Hours"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N)
)
Trtdata
labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
FamilyAntiFacetPlot=ggplot(Trtdata, aes(x=Hours,y=mean))+geom_bar(aes(fill = Hours),colour="black", stat="identity")+ facet_wrap(~Family)+xlab("Sample Type")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)+ scale_fill_manual(values=cbPalette)
FamilyAntiFacetPlot

kruskal.test(Shannon~ Month, data=df)

Means=compare_means(Abundance ~ Hours, data = df, method= "kruskal.test",
                    group.by = "Family", p.adjust.method = "fdr")

head(Means)
keeps <- c("Family","group1","group2","p.format","p.adj","method","p.signif")
keeps=Means[keeps]
#keeps
test3 <- list('Family'= keeps$Family,'group1'=keeps$group1,'group2'= keeps$group2 ,'p'=keeps$p.format,'p.adj'=keeps$p.adj,p.signif=keeps$p.signif,'Method'=keeps$method)
test3= as.data.frame(test3)
test3
FilteredResults<-test3[!(test3$p.adj>0.5),]
FilteredResults
################################

##################
##Compare sample types (Kruskal Wallis)
#################
#Phylum
GPr  = transform_sample_counts(physeq, function(x) x / sum(x) ) #transform samples based on relative abundance
GPrPhylum=tax_glom(GPr,"Phylum")
df=psmelt(GPrPhylum)
Means=compare_means(Abundance ~ Sample.Type, data = df,
                    group.by = "Phylum", p.adjust.method = "fdr")
#head(Means)
keeps <- c("Phylum","group1","group2","p.format","p.adj","method","p.signif")
keeps=Means[keeps]
#keeps
test3 <- list('Phylum'= keeps$Phylum,'group1'=keeps$group1,'group2'= keeps$group2 ,'p'=keeps$p.format,'p.adj'=keeps$p.adj,p.signif=keeps$p.signif,'Method'=keeps$method)
test3= as.data.frame(test3)
test3
FilteredResults<-test3[!(test3$p.adj>0.5),]
FilteredResults
#Family
GPr  = transform_sample_counts(physeq, function(x) x / sum(x) ) #transform samples based on relative abundance
GPrFamily=tax_glom(GPr,"Family")
df=psmelt(GPrFamily)
Means=compare_means(Abundance ~ Sample_Type, data = df,
                    group.by = "Phylum", p.adjust.method = "fdr")
#head(Means)
keeps <- c("Phylum","group1","group2","p.format","p.adj","method","p.signif")
keeps=Means[keeps]
#keeps
test3 <- list('Phylum'= keeps$Phylum,'group1'=keeps$group1,'group2'= keeps$group2 ,'p'=keeps$p.format,'p.adj'=keeps$p.adj,p.signif=keeps$p.signif,'Method'=keeps$method)
test3= as.data.frame(test3)
test3
FilteredResults<-test3[!(test3$p.adj>0.5),]
FilteredResults
##################################################
# logFoldChange between sample types Anti vs Postmortem
##################################################
diagdds = phyloseq_to_deseq2(GenusLevel, ~ Anti_Post) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)
diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res
alpha = 0.01
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GenusLevel)[rownames(sigtab), ], "matrix"))
head(sigtab)

# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Family`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Family` = factor(as.character(sigtab$sigtab$`Family`), levels=names(x))

sigtab$`Family` <- reorder(sigtab$`Family`, sigtab$log2FoldChange, sum)
sigtab$`FamilyGenus`= paste0(sigtab$Family,":",sigtab$Genus)
ggplot(sigtab, aes(x=`FamilyGenus`, y=log2FoldChange, color=`Family`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Anti vs Postmortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+ theme(legend.position="none")

##
##################################################
# logFoldChange between Sample_types antimortem  phylum
##################################################

sample_data(physeq)
#physeq2Intestine=subset_samples(physeq2, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
GPrIntestine=subset_samples(physeq, Sample.Type!="Ceca"& Sample.Type != "Cloacal_Swab")
GPrIntestine
GPrIntestineAnti=subset_samples(GPrIntestine, Anti_Post=="Antemortem")
GPrIntestineAnti
GPrIntestinePhylum <- subset_taxa(GPrIntestineAnti, Phylum != "NA")
GPrIntestinePhylum=tax_glom(GPrIntestinePhylum, "Phylum")
GPrIntestinePhylum = filter_taxa(GPrIntestinePhylum, function(x) mean(x) > 1e-2, TRUE)

physeqSampleType=subset_samples(physeq2, Sample_Type == "Small_Intestine_Tissue")
physeqSampleType <- subset_taxa(physeqSampleType, Phylum != "NA")
physeqSampleType=tax_glom(physeqSampleType, "Phylum")
sample_data(physeqSampleType)

diagdds = phyloseq_to_deseq2(physeqSampleType, ~ Anti_Post) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors
diagdds$TypeHours <- factor(paste0(diagdds$Sample_Type, diagdds$Hours))

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
res
alpha = 0.05
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(physeqSampleType)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Phylum`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Phylum` = factor(as.character(sigtab$sigtab$`Genus`), levels=names(x))

sigtab$`Genus` <- reorder(sigtab$`Genus`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Genus`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

sigtab

##################################################
# logFoldChange between  tissue type Antimortem glom Phylum
##################################################
#physeq2Intestine=subset_samples(physeq, Sample_Type!= "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
GPrIntestine=subset_samples(physeq, Sample.Type!="Cloaca"& Sample.Type != "Ceca")
GPrIntestineAnti=subset_samples(GPrIntestine, Anti_Post=="Antemortem")
GPrIntestineAnti
GPrIntestinePhylum <- subset_taxa(GPrIntestineAnti, Phylum != "NA")
GPrIntestinePhylum=tax_glom(GPrIntestinePhylum, "Phylum")
GPrIntestinePhylum = filter_taxa(GPrIntestinePhylum, function(x) mean(x) > 1e-2, TRUE)

sample_data(GPrIntestinePhylum)

diagdds = phyloseq_to_deseq2(GPrIntestinePhylum, ~ Type_Hours) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors
diagdds$TypeHours <- factor(paste0(diagdds$Sample_Type, diagdds$Hours))

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
res
alpha = 0.05
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GPrIntestinePhylum)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Genus`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Genus` = factor(as.character(sigtab$sigtab$`Genus`), levels=names(x))

sigtab$`Genus` <- reorder(sigtab$`Genus`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Genus`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

sigtab

##################################################
# logFoldChange between  tissue type Antimortem glom Family
##################################################
physeq2Intestine=subset_samples(physeq2, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
GPrIntestine=subset_samples(physeq2Intestine, Sample_Type!="Small_Intestine_Tissue"& Sample_Type != "Large_Intestine_Tissue")
GPrIntestineAnti=subset_samples(GPrIntestine, Anti_Post=="Post_Mortem")
GPrIntestineAnti
GPrIntestineFamily <- subset_taxa(GPrIntestineAnti, Family != "NA")
GPrIntestineFamily=tax_glom(GPrIntestineFamily, "Family")
GPrIntestineFamily = filter_taxa(GPrIntestineFamily, function(x) mean(x) > 1e-2, TRUE)
sample_data(GPrIntestineFamily)
diagdds = phyloseq_to_deseq2(GPrIntestineFamily, ~ Sample_Type) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors
diagdds$TypeHours <- factor(paste0(diagdds$Sample_Type, diagdds$Hours))

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
alpha = 0.05
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GPrIntestineFamily)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Family`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Family` = factor(as.character(sigtab$sigtab$`Family`), levels=names(x))

sigtab$`Family` <- reorder(sigtab$`Family`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Family`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

res
sigtab

##################################################
# logFoldChange Anti vs Postmortem Phylum
##################################################
physeq2Genus=subset_samples(physeq, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
#sample_data(physeq2Genus)
GPrGenus <- subset_taxa(physeq2Genus, Phylum != "NA")
GPrIntestineFamily=tax_glom(GPrGenus, "Phylum")
GPrIntestineFamily = filter_taxa(GPrIntestineFamily, function(x) mean(x) > 1e-2, TRUE)
#sample_data(GPrIntestineFamily)
diagdds = phyloseq_to_deseq2(GPrIntestineFamily, ~ Anti_Post) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
alpha = 0.05
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GPrIntestineFamily)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Phylum`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Family` = factor(as.character(sigtab$sigtab$`Phylum`), levels=names(x))

sigtab$`Family` <- reorder(sigtab$`Family`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Phylum`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

res
sigtab

##################################################
# logFoldChange Anti vs Postmortem Family
##################################################
physeq2Genus=subset_samples(physeq, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
#sample_data(physeq2Genus)
GPrGenus <- subset_taxa(physeq2Genus, Family != "NA")
GPrIntestineFamily=tax_glom(GPrGenus, "Family")
GPrIntestineFamily = filter_taxa(GPrIntestineFamily, function(x) mean(x) > 1e-2, TRUE)
#sample_data(GPrIntestineFamily)
diagdds = phyloseq_to_deseq2(GPrIntestineFamily, ~ Anti_Post) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
alpha = 0.05
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GPrIntestineFamily)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Family`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Family` = factor(as.character(sigtab$sigtab$`Family`), levels=names(x))

sigtab$`Family` <- reorder(sigtab$`Family`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Family`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

res
sigtab

##################################################
# logFoldChange Anti vs Postmortem Genus
##################################################
physeq2Genus=subset_samples(physeq, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
#sample_data(physeq2Genus)
GPrGenus <- subset_taxa(physeq2Genus, Genus != "NA")
GPrIntestineFamily=tax_glom(GPrGenus, "Genus")
GPrIntestineFamily = filter_taxa(GPrIntestineFamily, function(x) mean(x) > 1e-2, TRUE)
#sample_data(GPrIntestineFamily)
diagdds = phyloseq_to_deseq2(GPrIntestineFamily, ~ Anti_Post) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
alpha = 0.05
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GPrIntestineFamily)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Family`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Family` = factor(as.character(sigtab$sigtab$`Family`), levels=names(x))

sigtab$`Family` <- reorder(sigtab$`Family`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Family`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

res
sigtab

##################################################
# logFoldChange between Intestine tissue type Antimortem glom Genus
##################################################
physeq2Intestine=subset_samples(physeq2, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
GPrIntestine=subset_samples(physeq2Intestine, Sample_Type!="Ceca"& Sample_Type != "Cloacal_Swab")
GPrIntestineAnti=subset_samples(GPrIntestine, Anti_Post=="Anti_Mortem")
GPrIntestineAnti
GPrIntestineGenus <- subset_taxa(GPrIntestineAnti, Genus != "NA")
GPrIntestineGenus=tax_glom(GPrIntestineGenus, "Genus")

sample_data(GPrIntestineGenus)
diagdds = phyloseq_to_deseq2(GPrIntestineGenus, ~ Sample_Type) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors
diagdds$TypeHours <- factor(paste0(diagdds$Sample_Type, diagdds$Hours))

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)

diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
res$padj
alpha = 0.01
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(GPrIntestineGenus)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`Genus`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`Genus` = factor(as.character(sigtab$sigtab$`Genus`), levels=names(x))

sigtab$`Genus` <- reorder(sigtab$`Genus`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`Genus`, y=log2FoldChange, color=`Phylum`)) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Large vs Small Intestine Antimortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+scale_colour_manual(values=cbPalette)#+ theme(legend.position="none")

sigtab
###
sample_data(physeq)
#########################################################
####Beta diversity Intestine
########################################################
physeq=merge_phyloseq(biom,meta,tree)
physeq=subset_samples(physeq, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
GPrIntestine=subset_samples(physeq, Sample_Type!="Ceca"& Sample_Type != "Cloacal_Swab")
GPrIntestineAnti=subset_samples(GPrIntestine, Anti_Post=="Anti_Mortem")
GPrIntestineAnti=rarefy_even_depth(GPrIntestineAnti, sample.size = 100) #Sets the rarefaction depth

GPdist=phyloseq::distance(GPrIntestineAnti, "wunifrac")
adonis(GPdist ~ Sample_Type, as(sample_data(GPrIntestineAnti), "data.frame"))

#####
GPrIntestine=rarefy_even_depth(GPrIntestine, sample.size = 100) #Sets the rarefaction depth
ord=ordinate(GPrIntestine,"PCoA", "wunifrac") #other common methods besides for weighted unifrac include jaccard, bray, jsd
ordplot=plot_ordination(GPrIntestine, ord,"samples", color="Sample_Type")+geom_point(size=4)+scale_colour_manual(values=cbPalette)+scale_fill_manual(values=cbPalette)
ordplot+ stat_ellipse(type= "norm",geom = "polygon", alpha = 1/4, aes(fill = Sample_Type))+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
  facet_wrap(~Anti_Post)+ theme(legend.justification=c(1,0), legend.position=c(1,0))

###############
#Taxa plots large vs small intestine
#################
physeq4=subset_samples(physeq, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents") #Remove headgut swabs
GPrIntestine=subset_samples(physeq4, Sample_Type!="Ceca"& Sample_Type != "Cloacal_Swab")
GPr  = transform_sample_counts(GPrIntestine, function(x) x / sum(x) ) #transform samples based on relative abundance
GPrPhylum=tax_glom(GPr,"Phylum")
PhylumLevel = filter_taxa(GPrPhylum, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 0.1%
GPrFamily=tax_glom(GPr,"Family")
FamilyLevel = filter_taxa(GPrFamily, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
#FamilyLevel  = transform_sample_counts(FamilyLevel, function(x) x / sum(x) )
GPrGenus=tax_glom(GPr,"Genus")
GenusLevel = filter_taxa(GPrGenus, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
GPrGenus=tax_glom(GPr,"Species")
SpeciesLevel = filter_taxa(GPrGenus, function(x) mean(x) > 1e-2, TRUE) #filter out any taxa lower tha 1%
PhylumLevel=subset_samples(PhylumLevel, Anti_Post =="Post_Mortem")
df <- psmelt(PhylumLevel)
head(sample_data(PhylumLevel))
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Phylum", "Sample_Type","Hours"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N),
)
Trtdata

cdataplot=ggplot(Trtdata, aes(x=Hours,y=mean))+geom_bar(aes(fill = Phylum),colour="black", stat="identity")+xlab("")+ylab("Relative Abundance Antemortem (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+facet_wrap(~Sample_Type)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))#+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)#+ scale_fill_manual(values=cbPalette)+facet_grid(~Phylum)
cdataplot

cdataplot=ggplot(Trtdata, aes(x=Sample_Type,y=mean))+geom_bar(aes(fill = Sample_Type),colour="black", stat="identity")+xlab("")+ylab("Relative Abundance Postmortem (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)+ scale_fill_manual(values=cbPalette)+facet_wrap(~Phylum)
cdataplot

#Genus level
df <- psmelt(GenusLevel)
head(sample_data(GenusLevel))
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Genus", "Sample_Type","Hours"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N),
)
Trtdata

cdataplot=ggplot(Trtdata, aes(x=Hours,y=mean))+geom_bar(aes(fill = Genus),colour="black", stat="identity")+xlab("")+ylab("Relative Abundance Antemortem (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+facet_wrap(~Sample_Type)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))#+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)#+ scale_fill_manual(values=cbPalette)+facet_grid(~Phylum)
cdataplot

cdataplot=ggplot(Trtdata, aes(x=Hours,y=mean))+geom_bar(aes(fill = Sample_Type),colour="black", stat="identity")+xlab("")+ylab("Relative Abundance Postmortem (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)+ scale_fill_manual(values=cbPalette)+facet_wrap(SampleType~Genus)
cdataplot

###############################
###Random Forest Intestine
###############################
ForestData=physeq#Change this one so you dont have to rewrite all variables
GenusLevel
#GenusLevel=subset_samples(GenusLevel, Anti_Post == "Post_Mortem")
#GenusLevel=subset_samples(GenusLevel, Sample_Type != "Cloacal_Swab")
taxa_names(ForestData)=c("Morganella","Serratia","Escherichia","Enterococcus","Streptococcus","Lactococcus","Clostridium")
row.names(otu_table(ForestData))=c("Morganella","Serratia","Escherichia","Enterococcus","Streptococcus","Lactococcus","Clostridium")

predictors=t(otu_table(ForestData))
row.names
(otu_table(ForestData))
row.names(otu_table(ForestData))
(otu_table(ForestData))
#taxa_names(ForestData)=c("Morganella","Serratia","Escherichia","Enterococcus","Streptococcus","Lactococcus","Clostridium")
#row.names(otu_table(ForestData))=c("Morganella","Serratia","Escherichia","Enterococcus","Streptococcus","Lactococcus","Clostridium")

dim(predictors)
response <- as.factor(sample_data(ForestData)$Hours) #This is where you change the response variable ex Hours
rf.data <- data.frame(response, predictors)
MozzieForest <- randomForest(response~., data = rf.data, ntree = 1000)
print(MozzieForest)#returns overall Random Forest results
imp <- importance(MozzieForest)#all the steps that are imp or imp. are building a dataframe that contains info about the taxa used by the Random Forest testto classify treatment
imp <- data.frame(predictors = rownames(imp), imp)
imp.sort <- arrange(imp, desc(MeanDecreaseGini))
imp.sort$predictors <- factor(imp.sort$predictors, levels = imp.sort$predictors)
imp.20 <- imp.sort[1:20, ]
imp.20
ggplot(imp.20, aes(x = predictors, y = MeanDecreaseGini)) +
  geom_bar(stat = "identity", fill = "indianred") +
  coord_flip() #+
 # ggtitle("Most important functional groups for classifying  samples\n by hours")#\n in a string tells it to start a new line
imp.20$MeanDecreaseGini
otunames <- imp.20$predictors
r <- rownames(tax_table(ForestData)) %in% otunames
kable(tax_table(ForestData)[r, ])#returns a list of the most important predictors for Random Forest Classification

#To subset samples and only look at certain sample types

PhylumLevelCeca=subset_samples(PhylumLevel, Sample_Type== "Ceca") #Alternatively you can use Sample_Type != "Ceca" to include everything besides Ceca
PhylumLevelCeca
df <- psmelt(PhylumLevelCeca)
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Phylum", "Hours"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N)
)
#(Trtdata)
cdataplot=ggplot(Trtdata, aes(x=Hours,y=mean))+geom_bar(aes(fill = Phylum),colour="black", stat="identity")+ facet_grid(~Phylum)+xlab("")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  scale_x_discrete(labels=c("0 hrs", "24 hrs", "48 hrs","72 hrs"))+ theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1)#+ scale_fill_manual(values=cbPalette)
cdataplot

#Stacked barplot of Phylum level abundance by sample location and time
df <- psmelt(PhylumLevel)
df$Abundance=df$Abundance*100
Trtdata <- ddply(df, c("Phylum", "Hours","Sample_Type"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N)
)
#(Trtdata)
labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
cdataplot=ggplot(Trtdata, aes(x=Hours,y=mean))+geom_bar(aes(fill = Phylum),colour="black", stat="identity")+ facet_grid(~Sample_Type, labeller=labeller(Sample_Type = labels))+xlab("Treatment")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
   scale_x_discrete(labels=c("0 hrs", "24 hrs", "48 hrs","72 hrs"))+ theme(axis.text.x = element_text(angle = 45, hjust = 1))#+ scale_fill_manual(values=cbPalette)
cdataplot
#########################################

GPdist=phyloseq::distance(physeq, "wunifrac")
adonis(GPdist ~ Sample_Type*Anti_Post, as(sample_data(physeq), "data.frame"))

Post=subset_samples(physeq, Anti_Post =="Post_Mortem")
Anti=subset_samples(physeq, Anti_Post =="Anti_Mortem")
GPdist=phyloseq::distance(Post, "wunifrac")
adonis(GPdist ~ Sample_Type, as(sample_data(Post), "data.frame"))

ord=ordinate(physeq,"PCoA", "wunifrac")
ordplot=plot_ordination(physeq, ord,"samples", color="Anti_Post")+geom_point(size=4)+scale_colour_manual(values=cbPalette)+scale_fill_manual(values=cbPalette)
ordplot+ stat_ellipse(type= "norm",geom = "polygon", alpha = 1/4, aes(fill = Anti_Post))+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
   theme(legend.justification=c(1,0), legend.position=c(1,0))+facet_wrap(~Sample_Type)

#############################################################
###Beta dispersal
#################################
GPdist=phyloseq::distance(physeq, "wunifrac")
beta=betadisper(GPdist, sample_data(physeq)$Anti_Post)
permutest(beta)
boxplot(beta)

##########################
##PiCRUST
###############################
otufullPiCRUST=read.table("C:\\Users\\Joe Receveur\\Documents\\MSU data\\Starling\\StarlingR\\StarlingPiCrustMatrixL2.txt",header=TRUE)

metadata=read.table("C:\\Users\\Joe Receveur\\Documents\\Virtual Box\\Starling\\StarlingMeta4.18.txt",header=TRUE)
groupPiCRUST=as.matrix(read.csv("C:\\Users\\Joe Receveur\\Documents\\MSU data\\Starling\\StarlingR\\StarlingPiCrustGroupsL2.csv"))
head(groupPiCRUST)
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#000000","#CC79A7")
theme_set(theme_bw(base_size = 20)+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())) #sets the plotting theme

OTU=otu_table(otufullPiCRUST, taxa_are_rows=TRUE)
row.names(OTU)
TAX=tax_table(groupPiCRUST)

colnames(TAX)=("KEGG Pathway")
sampdat=sample_data(metadata)
sample_names(sampdat)=metadata$SampleID
row.names(OTU)=taxa_names(TAX)
PiCRUST=phyloseq(OTU,TAX,sampdat)
PiCRUST=subset_samples(PiCRUST, SampleID!="ST163" &SampleID!="ST186") #remove samples with less than 2,500 total reads
PiCRUST=subset_samples(PiCRUST, Sample_Type != "Headgut_Swab" & Sample_Type != "Small_Intestine_Contents")

sample_data(PiCRUST)

PiCRUST

##########################
##PiCRUST Deseq2
###############################
PiCRUSTIntestineAnti=subset_samples(PiCRUST, Anti_Post== "Anti_Mortem")
PiCRUSTIntestineAnti=subset_samples(PiCRUSTIntestineAnti, Sample_Type!="Small_Intestine_Tissue"& Sample_Type!="Cloacal_Swab"&Sample_Type!="Headgut_Swab")
sample_data(PiCRUSTIntestineAnti)
PiCRUST = filter_taxa(PiCRUST, function(x) mean(x) > 1e-2, TRUE)

diagdds = phyloseq_to_deseq2(PiCRUST, ~ Anti_Post) #Here is where you choose what variable you want to look at ex Anti_Post, log fold change can only deal with two groups so you will have to subset your samples
# calculate geometric means prior to estimate size factors

gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}
geoMeans = apply(counts(diagdds), 1, gm_mean)
diagdds = estimateSizeFactors(diagdds, geoMeans = geoMeans)
diagdds = DESeq(diagdds, fitType="local")

res = results(diagdds, cooksCutoff = FALSE)
alpha = 0.05
res$padj
sigtab = res[which(res$padj < alpha), ]
sigtab = cbind(as(sigtab, "data.frame"), as(tax_table(PiCRUST)[rownames(sigtab), ], "matrix"))
head(sigtab)
sigtab
sigtab$`KEGG Pathway`
theme_set(theme_bw())

# Group log fold change plot
x = tapply(sigtab$log2FoldChange, sigtab$`KEGG Pathway`, function(x) max(x))
x = sort(x, TRUE)
sigtab$sigtab$`KEGG Pathway` = factor(as.character(sigtab$sigtab$`KEGG Pathway`), levels=names(x))

sigtab$`KEGG Pathway` <- reorder(sigtab$`KEGG Pathway`, sigtab$log2FoldChange, sum)
ggplot(sigtab, aes(x=`KEGG Pathway`, y=log2FoldChange, color=`KEGG Pathway`, )) + geom_point(size=6)+
  theme(axis.text.x = element_text(angle = -90, hjust = 0, vjust=0.5))+ ylab("log2FoldChange Anti vs Postmortem (SEM)")+
  geom_errorbar(aes(ymin=log2FoldChange-lfcSE,ymax=log2FoldChange+lfcSE),color="black",width=1)+ theme(legend.position="none")
PiCRUSTsum  = transform_sample_counts(PiCRUST, function(x) x / sum(x) ) #transform samples based on relative abundance

PiCRUSTKEGG = filter_taxa(PiCRUSTsum, function(x) mean(x) > 1e-2, TRUE)
PiCRUSTKEGGAnti=subset_samples(PiCRUSTKEGG, Anti_Post != "Post_Mortem")
PiCRUSTKEGGAnti
#df <- psmelt(PiCRUSTKEGGAnti)
sample_data(PiCRUSTKEGGAnti)
df <- psmelt(PiCRUSTKEGG)
df$Abundance=df$Abundance*100
head(df)
Trtdata <- ddply(df, c("KEGG.Pathway","Anti_Post"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N))
#(Trtdata)
labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
cdataplot=ggplot(Trtdata, aes(x=Anti_Post,y=mean))+geom_bar(aes(fill = KEGG.Pathway),colour="black", stat="identity")+xlab("Treatment")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  scale_x_discrete(labels=c("0 hrs", "24 hrs", "48 hrs","72 hrs"))+ theme(axis.text.x = element_text(angle = 45, hjust = 1))#+ scale_fill_manual(values=cbPalette) + facet_wrap(~Sample_Type, labeller=labeller(Sample_Type = labels))
cdataplot+guides(fill=FALSE)

Trtdata <- ddply(df, c("KEGG.Pathway", "Sample_Type"), summarise,
                 N    = length(Abundance),
                 mean = mean(Abundance),
                 sd   = sd(Abundance),
                 se   = sd / sqrt(N))
#head(Trtdata)
labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
cdataplot=ggplot(Trtdata, aes(x=Anti_Post,y=mean))+geom_bar(aes(fill = Anti_Post),colour="black", stat="identity")+ facet_wrap(~KEGG.Pathway,labeller = label_wrap_gen(width=10),nrow = 2)+xlab("Treatment")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1) + scale_fill_manual(values=cbPalette)#scale_x_discrete(labels=c("0 hrs", "24 hrs", "48 hrs","72 hrs"))+
cdataplot+guides(fill=FALSE)

###############Richness tests
Diversity=read.table("C:\\Users\\Joe Receveur\\Documents\\MSU data\\Starling\\StarlingMeta4.18WDiversity.txt",header=TRUE)
head(Diversity)
AntimortemDiv <- subset(Diversity, Sample_Type == 'Ceca')
(AntimortemDiv)
Trtdata <- ddply(Diversity, c("Anti_Post", "Sample_Type"), summarise,
                 N    = length(shannon),
                 mean = mean(shannon),
                 sd   = sd(shannon),
                 se   = sd / sqrt(N))
Trtdata
head(Trtdata)
labels <- c(Ceca = "Ceca", Cloacal_Swab = "Cloacal Swab",Large_Intestine_Tissue="Large Intestine Tissue", Small_Intestine_Contents="Small Intestine Contents",Headgut_Swab="Headgut Swab",Small_Intestine_Tissue="Small Intestine Tissue")
cdataplot=ggplot(Trtdata, aes(x=Anti_Post,y=mean))+geom_bar(aes(fill = Sample_Type),colour="black", stat="identity")+xlab("Sample Type")+ylab("Shannon Diversity") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+geom_errorbar(aes(ymin=mean-se,ymax=mean+se),color="black",width=1) + scale_fill_manual(values=cbPalette)+facet_wrap(~Sample_Type)#scale_x_discrete(labels=c("0 hrs", "24 hrs", "48 hrs","72 hrs"))+
cdataplot+guides(fill=FALSE)

kruskal.test(shannon~ Anti_Post, data=AntimortemDiv)

Means=compare_means(shannon ~ Hours, data = AntimortemDiv, method= "wilcox",
                   , p.adjust.method = "fdr")
Means

PhylumFacetPlotByType=ggplot(dat[Abundance > 0], aes(x=Hours,y=mean))+geom_bar(aes(fill = Phylum),colour="black", stat="identity")+xlab("Sample Type")+ylab("Relative Abundance (> 1%)") + theme(axis.text.x = element_text(angle = 0, hjust = 0.5))+theme(axis.title.x=element_blank())+
  theme(axis.text.x = element_text(angle = 0))+ scale_fill_manual(values=cbPalette)+facet_grid(~Sample.Type)
PhylumFacetPlotByType+ scale_x_continuous(breaks=c(0,24,48,72))


#=====================================================
#Web of Science was used to locate the citations
#of individual papers that used or cited the
#following software packages:
#ADMB, Stan, TMB, JAGS, Classic BUGS, WinBUGS,
#OpenBUGS
#Since multiple methods were used to find citing
#papers, duplicates must be removed before returning
#the cites by year.
#=====================================================
XX <- read.csv("Citation analysis.csv", stringsAsFactors=F)
software <- c("Classic BUGS", "WinBUGS", "OpenBUGS",
              "JAGS", "ADMB", "TMB", "Stan")
nsoftware <- length(software)
years <- seq(min(XX$PY), 2015, 1)
nyears <- length(years)
results <- matrix(nrow=nyears, ncol=nsoftware,
                  dimnames=list(years,software))
#get data in the right format
for (i in 1:nsoftware) {
   #go through the data for each software package in turn
   Xdata <- XX[XX$Software.package==software[i],]
   #find the duplicated doi values
   doi.dups <- duplicated(Xdata$DI, incomparables=c(""))
   #find the duplicated journal+vol+pagestart
   journal.dups <- duplicated(paste(Xdata$SO, Xdata$VL, Xdata$BP),
                              incomparables=c(""))
   #find the duplicated WOS codes
   WOS.dups <- duplicated(Xdata$UT, incomparables=c(""))
   #extract the years (PY) from the data where there
   #are no duplicates
   #results[,i] <- hist(Xdata[!(doi.dups | journal.dups | WOS.dups),"PY"],
   #     breaks=seq(years[1]-0.5,years[nyears]+0.5,1), main="",
   #     xlab="Year", ylab="Citations", col="gray50")$counts
   results[,i] <- tabulate(factor(Xdata[!(doi.dups | journal.dups | WOS.dups),"PY"], levels = years)) #alt way of getting results
   ##   mtext(side=3,line=-1,software[i], cex=1.3)
}
write.csv(file="CountsByYear.csv",results)

## #create plot of citations
## pdf("Draft.pdf",width=12,height=12)
## mat <- matrix(1:nsoftware, nrow=nsoftware, ncol=1)
## par(mar=c(0,0,0,0), oma=c(3,3,1,1))
## ylims <- 110+apply(results, MARGIN=2, FUN=max)
## layout(mat=mat, widths=1, heights=ylims)
## for (i in 1:nsoftware) {
##    if (i==nsoftware) {
##       names.arg <- years
##    } else {
##       names.arg <- NA
##    }
##    barplot(results[,i], col="gray", ann=F, axes=F, names.arg=names.arg,
##            xaxs="i", yaxs="i", ylim=c(0,ylims[i]))
##    box()
##    axis(side=2, las=1, at=seq(0,600,100))
##    mtext(side=3, line =-1.7, outer=F, software[i], cex=1)
## }
## mtext(side=1, line=3, outer=T, "Year", cex=1.3)
## mtext(side=2, line=3, outer=T, "Number of citations", cex=1.3)
## dev.off()