library("RNetCDF")

###CDF open
setwd(inputDrive)
cdf.dat <- open.nc(mainFilename.cdf,write=TRUE)

old.op <- options(max.print=9999999)
flag <- var.get.nc(cdf.dat, "flag_count")
scantime <- var.get.nc(cdf.dat, "scan_acquisition_time")
medmsmax <- var.get.nc(cdf.dat, "mass_range_max")
medmsmin <- var.get.nc(cdf.dat, "mass_range_min")
ionid <- var.get.nc(cdf.dat, "scan_index")
eachscannum <- var.get.nc(cdf.dat, "point_count")
MStotint <- var.get.nc(cdf.dat, "total_intensity")
MSvalue <- var.get.nc(cdf.dat, "mass_values")
MSint <- var.get.nc(cdf.dat, "intensity_values")

Timepara <- scantime[which(abs(eachscannum)<.Machine$integer.max )]
RTini <- min( Timepara )/60
RTruntime <- max( Timepara )/60-RTini
SamRate <- 1/(mean( Timepara[2:length(Timepara)]-Timepara[1:(length(Timepara)-1) ] ))

pixelnum <- length(flag)
maxscannum <- max(eachscannum)
minscannum <- min(eachscannum)
MSdatabox <- matrix(0,pixelnum, maxscannum+1 )
MSvaluebox <- MSdatabox
MSintbox <- MSdatabox

for (inum in 1:pixelnum) {
        if (abs(eachscannum[inum])<.Machine$integer.max){
                initial <- sum(eachscannum[1:inum])-eachscannum[inum]+1
                acqrange <- initial:(initial+eachscannum[inum]-1)
                if(eachscannum[inum]==0){acqrange <-0}
                remainrep <- rep(0,maxscannum-eachscannum[inum]+1 )
                MSvaluebox[inum,] <- c( MSvalue[ acqrange ], remainrep )
                MSintbox[inum,] <- c( MSint[ acqrange ], remainrep )
        }
}

rownames(MSvaluebox) <-1:(pixelnum)
rownames(MSintbox) <-1:(pixelnum)
MSvaluebox[which(MSintbox > 9e+36)] <- -1
MSintbox[which(MSintbox > 9e+36)] <- -1

row3 <- round(SamRate*MPeriod)
col3 <- round(length(scantime)/row3)
row3
col3
tic.box <- as.matrix( rowSums(MSintbox)  )

###length adjustment
shaded.mat.vector <- as.vector(t(shaded.mat))
format.mat.pre <- c(0,shaded.mat.vector)[1:length(shaded.mat.vector)]  #GCImage unieque; starting location=0.
###phase.shift adjustment
if (phase.shift.cdf < 0){
	add.pix.number <- round(phase.shift.cdf*SamRate)
	add.pix.vector <- rep(0,add.pix.number)
	format.mat <- c(add.pix.vector,format.mat.pre)[1:length(format.mat.pre)]
}
if (phase.shift.cdf > 0){
	reduc.pix.number <- round(phase.shift.cdf*SamRate)-1
	format.mat <- format.mat.pre[(reduc.pix.number+1):length(format.mat.pre)]
}
if (phase.shift.cdf == 0){
	format.mat <- format.mat.pre[1:length(format.mat.pre)]
}

if ( nrow(MSintbox) > length(format.mat) ){
	format.mat <- c(format.mat, rep(min(format.mat),nrow(MSintbox)-length(format.mat) ) )
}
if ( nrow(MSintbox) < length(format.mat) ){
	format.mat <- format.mat[1:nrow(MSintbox)]
}

MSintbox.multi <- MSintbox * (format.mat)

###CDF output
setwd(outputDrive)
if ( nrow(MSintbox.multi) > length(eachscannum) ){
        loop.length <- length(eachscannum)
}
if ( nrow(MSintbox.multi) <= length(eachscannum) ){
        loop.length <- nrow(MSintbox.multi)
}

for (i in 1:loop.length ) {
        if (abs(eachscannum[i])<.Machine$integer.max){
                initial <- sum(eachscannum[1:i])-eachscannum[i]+1
                acqrange <- initial:(initial+eachscannum[i]-1)
                if(eachscannum[i]==0){acqrange <-0}
                        MSvalue[acqrange] <- MSvaluebox[i, 1:length(acqrange) ]
                        MSint[acqrange] <- MSintbox.multi[i, 1:length(acqrange) ] #eval(parse(text=paste("MSintbox",sep="")))
                }
        }

ncnew <- create.nc( output.name.cdf,large=TRUE )

scan_number <- dim.def.nc(ncnew, dimname="scan_number", dimlength=length(scantime))
point_number <- dim.def.nc(ncnew, dimname="point_number", dimlength=length(MSint) )

var.def.nc(ncnew,  varname="flag_count", dimensions="scan_number",  vartype="NC_INT")
var.def.nc(ncnew, varname="scan_acquisition_time", dimensions="scan_number",vartype="NC_DOUBLE" )
var.def.nc(ncnew, varname="mass_range_max", dimensions="scan_number",vartype="NC_DOUBLE" )
var.def.nc(ncnew, varname="mass_range_min", dimensions="scan_number",vartype="NC_DOUBLE" )
var.def.nc(ncnew, varname="scan_index", dimensions="scan_number",vartype="NC_INT" )
var.def.nc(ncnew, varname="point_count", dimensions="scan_number",vartype="NC_INT" )
var.def.nc(ncnew, varname="total_intensity", dimensions="scan_number",vartype="NC_DOUBLE" )
var.def.nc(ncnew, varname="mass_values", dimensions="point_number",vartype="NC_DOUBLE" )
var.def.nc(ncnew, varname="intensity_values", dimensions="point_number",vartype="NC_FLOAT" )

var.put.nc(ncnew, variable="flag_count",data=flag)
var.put.nc(ncnew, variable="scan_acquisition_time",data=scantime)
var.put.nc(ncnew, variable="mass_range_max",data=medmsmax)
var.put.nc(ncnew, variable="mass_range_min",data=medmsmin)
var.put.nc(ncnew, variable="scan_index",data=ionid)
var.put.nc(ncnew, variable="point_count",data=eachscannum)
var.put.nc(ncnew, variable="total_intensity",data=MStotint)
var.put.nc(ncnew, variable="mass_values",data=MSvalue)
var.put.nc(ncnew, variable="intensity_values",data=MSint)
close.nc(ncnew)


open H2.xyz
bond 1.55
model GAFF
thermostat ANDERSEN
energy
minimize 0.0001 0.00001 40000 1000 min.xyz
energy
heat 300 50 400 0.01 0.01 0.0001 0.00001 0.3 heat.xyz
temperature
energy
prod 0.0001 0.0001 300 .3 50000 10 prod.xyz


#' Well sampled sites model
#'
#' This function is a wrapper for \code{siteSelection} and \code{reportingRateModel} that
#' allows users the run a well sampled sites analysis as in Roy et al (2012).
#'
#' @param taxa A character vector of taxon names, as long as the number of observations.
#' @param site A character vector of site names, as long as the number of observations.
#' @param time_period A numeric vector of user defined time periods, or a date vector,
#'        as long as the number of observations.
#' @param minL numeric, The minimum number of taxa recorded at a site at a given time period
#'        (list-length) for the visit to be considered well sampled.
#' @param minTP numeric, The minimum number of time periods, or if time_period is a date the minimum
#'        number of years, a site must be sampled in for it be be considered well sampled.
#' @param species_to_include A character vector giving the name of species to model. By default
#'        all species will be modelled
#' @param overdispersion This option allows modelling overdispersion (\code{TRUE}) in models.
#'        Default is \code{FALSE}.
#' @param family The type of model to be use. Can be \code{"Binomial"} or \code{"Bernoulli"}.
#' @param verbose This option, if \code{TRUE}, sets models to verbose, allowing the
#'        interations of each model to be viewed.
#'
#' @param print_progress Logical, if \code{TRUE} progress is printed to console when
#'        running models. Default is \code{TRUE}
#'
#' @return A dataframe of results are returned to R. Each row gives the results for a
#'         single species, with the species name given in the first column, \code{species_name}.
#'         For each of the following columns the prefix (before ".") gives the covariate and the
#'         sufix (after the ".") gives the parameter of that covariate.
#'         \code{number_observations} gives the number of visits where the species of interest
#'         was observed. If any of the models encountered an error this will be given in the
#'         column \code{error_message}.\cr
#'
#'         The data.frame has a number of attributes:
#'         \itemize{
#'          \item{\code{intercept_year}}{ - The year used for the intercept (i.e. the
#'           year whose value is set to 0). Setting the intercept to the median year helps
#'           to increase model stability}
#'          \item{\code{min_year} and \code{max_year}}{ - The earliest and latest year
#'           in the dataset (after years have been centered on \code{intercept_year}}
#'          \item{\code{nVisits}}{ - The total number of visits that were in the dataset}
#'          \item{\code{model_formula}}{ - The model used, this will vary depending on the
#'           combination of arguements used}
#'          \item{\code{minL}}{ - The setting of minL used in site selection}
#'          \item{\code{minTP}}{ - The setting of minTP used in site selection}
#'          }
#' @references Roy, H.E., Adriaens, T., Isaac, N.J.B. et al. (2012) Invasive alien predator
#'             causes rapid declines of native European ladybirds. Diversity & Distributions,
#'             18, 717-725.
#' @export
#' @examples
#' # Create data
#' n <- 1500 #size of dataset
#' nyr <- 8 # number of years in data
#' nSamples <- 20 # set number of dates
#'
#' # Create somes dates
#' first <- as.POSIXct(strptime("2003/01/01", "%Y/%m/%d"))
#' last <- as.POSIXct(strptime(paste(2003+(nyr-1),"/12/31", sep=''), "%Y/%m/%d"))
#' dt <- last-first
#' rDates <- first + (runif(nSamples)*dt)
#'
#' # taxa are set as random letters
#' taxa <- sample(letters, size = n, TRUE)
#'
#' # three sites are visited randomly
#' site <- sample(c('one', 'two', 'three'), size = n, TRUE)
#'
#' # the date of visit is selected at random from those created earlier
#' time_period <- sample(rDates, size = n, TRUE)
#'
#' # combine this to a dataframe
#' df <- data.frame(taxa, site, time_period)
#'
#' results <- WSS(df$taxa,
#'                 df$site,
#'                 df$time_period,
#'                 minL = 4,
#'                 minTP = 3,
#'                 species_to_include = c('a', 'b', 'c'))
#'
#' # Look at the results for the first few species
#' head(results)
#' # Look at the attributes of the object returned
#' attributes(results)

WSS <- function(taxa, site, time_period, minL = 2, minTP = 3,
                species_to_include = unique(taxa),
                overdispersion = FALSE, family = 'Binomial',
                verbose = FALSE, print_progress = FALSE){

  selected_data  <- siteSelection(taxa,
                          site,
                          time_period,
                          minL,
                          minTP,
                          LFirst = TRUE)

  WSS_result <- reportingRateModel(selected_data$taxa,
                                   selected_data$site,
                                   selected_data$time_period,
                                   list_length = FALSE,
                                   site_effect = TRUE,
                                   verbose = verbose,
                                   print_progress = print_progress,
                                   overdispersion = overdispersion,
                                   family = family,
                                   species_to_include = species_to_include)

  attr(WSS_result, 'minL') <- minL
  attr(WSS_result, 'minTP') <- minTP

  return(WSS_result)

}


add_icemask <- function() {
	icemask = raster('data/icemask.nc')
	plot_raster_from_raster(icemask, add = TRUE, cols = c('#FFFFFFFF', 'grey'),
						    limits = c(-0.5, 0.5), add_legend = FALSE, interior = FALSE )
}


#!/usr/bin/Rscript

##############################################################################
# Logistic regression model
##############################################################################
args <- commandArgs(trailingOnly=TRUE)
# args <- c("AT", "/net/bipolar/jedidiah/mutation", "/net/snowwhite/home/jedidiah/R/x86_64-pc-linux-gnu-library/3.3", 16)
catopt <- args[1]
parentdir <- args[2]
libpath <- args[3]
jobid <- args[4]
jobid <- as.numeric(jobid)

.libPaths(c(.libPaths(), libpath))

options(useHTTPS=FALSE)
options(scipen = 8)

suppressPackageStartupMessages(library("speedglm", quietly=TRUE, warn.conflicts=FALSE))
suppressPackageStartupMessages(library("smaug", quietly=TRUE, warn.conflicts=FALSE))
suppressPackageStartupMessages(library("dplyr", quietly=TRUE, warn.conflicts=FALSE))
suppressPackageStartupMessages(library("boot", quietly=TRUE, warn.conflicts=FALSE))
suppressPackageStartupMessages(library("yaml", quietly=TRUE, warn.conflicts=FALSE))
suppressPackageStartupMessages(library("bedr", quietly=TRUE, warn.conflicts=FALSE))

# source(paste0(parentdir, "/smaug-genetics/R/get_functions.r"))

yaml_args <- yaml.load_file(paste0(parentdir, "/smaug-genetics/_config.yaml"))
attach(yaml_args)

nbp_run <- 7

# Fast list of 6 basic categories from agg_5bp_100k data
mut_cats <- c("AT_CG", "AT_GC", "AT_TA", "GC_AT", "GC_CG", "GC_TA")

# subset reference data to only AT or GC bases
# catopt <- substr(categ,0,2)

run_cats <- mut_cats[grepl(paste0("^", catopt), mut_cats)]

motiffile <- paste0(parentdir, "/output/7bp_1000k_rates.txt")
incmd <- paste0("cut -f1-3 ", motiffile)
motifdat <- read.table(pipe(incmd), header=T, stringsAsFactors=F)
motifs <- motifdat %>%
	mutate(Category=gsub("cpg_", "", Category2)) %>%
	filter(grepl(paste0("^", catopt), Category)) %>%
	dplyr::select(Sequence) %>%
	unlist %>% unique

runmotif <- motifs[jobid]
escmotif <- substr(runmotif, 0, nbp_run)

# stopif(file.exists(paste0(parentdir, "output/logmod_data/coefs")))

sitefile <- paste0(parentdir, "/output/logmod_data/motifs3/", escmotif, ".txt")
sites <- read.table(sitefile, header=F, stringsAsFactors=F)
names(sites) <- c("CHR", "POS", "Sequence", mut_cats, "DP")
sites <- sites %>%
	arrange(CHR, POS)

# Add histone marks to site data
hists <- c("H3K4me1", "H3K4me3", "H3K9ac", "H3K9me3",
	"H3K27ac", "H3K27me3", "H3K36me3")
dflist <- list()
for(i in 1:length(hists)){
  mark <- hists[i]
  file <- paste0(parentdir, "/reference_data/sort.E062-",
		mark, ".bed")
  hist <- binaryCol(sites, file)
  dflist[[i]] <- hist
}

df <- as.data.frame(do.call(cbind, dflist))
names(df) <- hists
sites <- cbind(sites, df)

# Add other features
sites$EXON <- binaryCol(sites,
	paste0(parentdir, "/reference_data/GRCh37_RefSeq_sorted.bed"))
sites$CpGI <- binaryCol(sites,
	paste0(parentdir, "/reference_data/cpg_islands_sorted.bed"))
sites$RR <- rcrCol(sites,
	paste0(parentdir, "/reference_data/recomb_rate.bed"))
sites$LAMIN <- binaryCol(sites,
	paste0(parentdir, "/reference_data/lamin_B1_LADS2.bed"))
sites$DHS <- binaryCol(sites,
	paste0(parentdir, "/reference_data/DHS.bed"))
sites$TIME <- repCol(sites,
	paste0(parentdir, "/reference_data/lymph_rep_time.txt"))
sites$GC <- gcCol(sites,
	paste0(parentdir, "/reference_data/gc10kb.bed"))

# write.table(sites[,!(names(mtcars) %in% c("CHR", "POS", "Sequence"))],
# 	paste0(parentdir, "/output/logmod_data/annotated/", escmotif, "_annotated.txt"))

##############################################################################
# Function for running logit model--given input motif,
# writes predicted mutation rates and returns list of coefficient estimates
##############################################################################
logitMod <- function(sites, categ, split){

	# sites$GC <- gcContentCalc(sites_for_GC, 10000, organism=Hsapiens)

	# Run logit model for categories with >10 singletons, return coefficients
	# Otherwise, returns single marginal rate
	predicted <- sites[,1:2]

	coefs <- data.frame()
	mut_cats <- c("AT_CG", "AT_GC", "AT_TA", "GC_AT", "GC_CG", "GC_TA")
	ind <- match(categ, mut_cats)+3

	if(sum(sites[,ind])>10){
		log_mod_formula <- as.formula(paste(categ, "~",
			paste(names(sites)[-(1:9)], collapse="+")))
		log_mod <- speedglm(log_mod_formula, data=sites, family=binomial(), maxit=50)

		predicted$mu <- round(inv.logit(predict(log_mod, newdata=sites)), 6)

		predicted$mu[is.na(predicted$mu)] <- round(sum(sites[,ind])/nrow(sites), 6)

		# Get coefficients from model summary, clean up data formats
		coefs <- data.frame(summary(log_mod)$coefficients, stringsAsFactors=F)
		coefs <- cbind(Cov = rownames(coefs), coefs)
		coefs$Cov <- as.character(coefs$Cov)
		rownames(coefs) <- NULL
		names(coefs) <- c("Cov", "Estimate", "SE", "Z", "pval")
		coefs$pval <- as.numeric(as.character(coefs$pval))

		coefs$Sequence <- escmotif

	} else {
		cat("Not enough data--predicted rates will be marginal rate only\n")
		predicted$mu <- round(sum(sites[,ind])/nrow(sites), 6)
	}

	# New dir for each chromosome (faster to write, slower to sort?)
	if(split){
		cat(paste0("Writing predicted rates to: ", parentdir, "/output/predicted/", categ, "/chr*/", escmotif, ".txt\n"))
		chr.split <- split(predicted, predicted$CHR)
		for(i in 1:length(chr.split)){
			chr <- unique(chr.split[[i]]$CHR)
			preddir <- paste0(parentdir, "/output/predicted/", categ, "/chr", chr, "/")
			dir.create(preddir, recursive=T, showWarnings = FALSE)

			predfile <- paste0(preddir, categ, "_", escmotif, ".txt")
			write.table(chr.split[[i]], predfile,
				col.names=F, row.names=F, quote=F, sep="\t")
		}
	}

	return(coefs)
}

##############################################################################
# Run models
##############################################################################
cat("Running model on", runmotif, "sites...\n")

for(categ in run_cats){
	coefs <- logitMod(sites=sites, categ=categ, split=TRUE)

	coefdir <- paste0(parentdir, "/output/logmod_data/coefs/", categ, "/")
	dir.create(coefdir, recursive=T, showWarnings = FALSE)
	coeffile <- paste0(coefdir, categ, "_", escmotif, "_coefs.txt")
	cat(paste0("Writing coefficient estimates to: ", coeffile, "\n"))
	write.table(coefs, coeffile, col.names=F, row.names=F, quote=F, sep="\t")
}


#Sys.setenv("PKG_LIBS"="-lprofiler")
if(Sys.getenv("USER")=="ebjan"){
  setwd("~/trw")
}else{
  setwd("~/Dropbox/trw")
}
#Creates data used for tests

#source("~/Dropbox/trw/trw_run.r")
#source("~/Dropbox/trw/trw_fns.r")
source("suff_stats.r")
source("likelihoods.r")
Rcpp::sourceCpp("./trw.cpp")
source("trw_fit.r")
#source("~/Dropbox/trw/trw_global.r")

#setwd("./Experiments/Data")

libs=c(
  "Matrix",
  "orthopolynom",
  "igraph",
  "Rcpp",
  "inline",
  "RcppArmadillo",
  "parallel",
  "SnowballC",
  "ape",
  "mclust",
  "huge",
  "glasso",
  "abind")
if (sum(!(libs %in% .packages(all.available = TRUE))) > 0) {
  install.packages(libs[!(libs %in% .packages(all.available = TRUE))],
                   repos="http://cran.stat.ucla.edu")
}
for (i in 1:length(libs)) {
  library(libs[i],character.only = TRUE,quietly=TRUE)
}

library(RBGL)

res=128
seq.Out<-seq(from=0,to=1,length.out=res)
cores=detectCores()

legen.Vec<-legendre_Pl_array(m1,2*seq.Out-1)[-1,,drop=F]
#leg.mat<-legen.Vec%*%t(legen.Vec)
legen.array<-array(dim=c(res,res,m2^2))
k=1
for(i in 1:m2){
  for(j in 1:m2){
    legen.array[,,k]<-tcrossprod(legen.Vec[i,],legen.Vec[j,])
    k=k+1
  }
}

mixlik<-function(test,mclustout){
	d=dim(test)[2]
	out2=lapply(1:dim(test)[1],function(x){
		out=0
		for(i in 1:length(mclustout$pro)){
			out= out + mclustout$pro[i]*(det(mclustout$variance$sigma[,,i])^(-1/2))*
				exp(-.5*crossprod(test[x,]-mclustout$mean[,i],solve(mclustout$variance$sigma[,,i]))%*%(test[x,]-mclustout$mean[,i]))
		}
	return( log(out) - (d/2)*log(2*pi) )
	})
	return(-mean(unlist(out2)))
}


#!/usr/bin/env Rscript
#########################################
# dada2_errmodels_pacbio
#
# DADA2 sequence error estimation based on files in a given folder
# Assumes PacBio reads, i.e. uses errorEstimationFunction = PacBioErrfun
#
# Author: Jeanette Tångrot (jeanette.tangrot@nbis.se), Daniel Lundin

suppressPackageStartupMessages(library(optparse))

VERSION = 1.0

# Get arguments
option_list = list(
  make_option(
    c('--filterDir'), type='character', default='dada2_filtered',
    help='Directory containing quality filtered reads to estimate sequence errors from, default "dada2_filtered".'
  ),
  make_option(
    c('--prefix'), type='character', default='./',
    help='Prefix for name of rds file with DADA2 error model. Can include a path to another folder. Default: "./"'
  ),
  make_option(
    c('--nbases'), type='character', default=1e8,
    help='Minimum number of total bases to use for error estimation, please see DADA2 documentation for details. Default: 1e8'
  ),
  make_option(
    c("-v", "--verbose"), action="store_true", default=FALSE,
    help="Print progress messages."
  ),
  make_option(
    c("--version"), action="store_true", default=FALSE,
    help="Print version of script and DADA2 library."
  )
)
opt = parse_args(OptionParser(option_list=option_list))

if ( opt$version ) {
  write(sprintf("dada2_errmodels_pacbio.r version %s, DADA2 version %s", VERSION, packageVersion('dada2')), stderr())
  q('no', 0)
}

# Check options
if ( ! file_test("-d", opt$filterDir) ) {
   stop( sprintf("Cannot find folder with filtered files: %s. See help (-h)\n",opt$filterDir) )
}

# Function for log messages
logmsg = function(msg, llevel='INFO') {
  if ( opt$verbose ) {
    write(
      sprintf("%s: %s: %s", llevel, format(Sys.time(), "%Y-%m-%d %H:%M:%S"), msg),
      stderr()
    )
  }
}

logmsg( sprintf( "Sequence error estimation with DADA2 learnErrors and PacBioErrFun." ) )

# Load DADA2 library here, to avoid --help and --version taking so long
suppressPackageStartupMessages(library(dada2))
suppressPackageStartupMessages(library(ShortRead))

# Do the error estimation, save rds for error profile
files=list.files(opt$filterDir,full.names=T)
logmsg( sprintf("Using files: %s", files))
err <- learnErrors(files, errorEstimationFunction=PacBioErrfun, multithread=TRUE, randomize=FALSE, verbose=opt$verbose, nbases=as.double(opt$nbases))
saveRDS(err,sprintf('%serr.rds', opt$prefix))

logmsg(sprintf("Finished error estimation"))


nsp<-23
noth<-14
fy.VPA<-1975
ly.VPA<-2005
fa<-0
la<-10

fy.for<-2006
ly.for<-2030
ny<-ly.for-fy.for+1

file<-file.path(data.path,'Length_weight_relations.in')
lw<-read.table(file,header=F)
lw<-data.frame(Species.n=as.factor(seq(1,dim(lw)[1])),a=lw$V1,b=lw$V2)

file<-file.path(data.path,'west.in')
west<-array(scan(file,comment.char = "#"),dim=c(la-fa+1,4,ly.VPA-fy.VPA+1,nsp),dimnames=list(fa:la,1:4,fy.VPA:ly.VPA,1:nsp))
op<-arr2dfny(west)
west<-data.frame(Age=op$index.1,Quarter=op$index.2,Year=op$index.3,Species.n=(op$index.4),W=op$y)

file<-file.path(data.path,'other_pred_N.in')
op<-array(scan(file,comment.char = "#"),dim=c(la-fa+1,4,ly.VPA-fy.VPA+1,noth),dimnames=list(fa:la,1:4,fy.VPA:ly.VPA,1:noth))
op<-arr2dfny(op)
op<-data.frame(Age=op$index.1,Quarter=op$index.2,Year=op$index.3,Species.n=(op$index.4),oth.N=op$y)

other<-merge(west,op)
other<-subset(other,other$oth.N>0 )
other<-data.frame(Age=as.factor(other$Age),Quarter=as.factor(other$Quarter),
            Year=as.factor(other$Year),Species.n=as.factor(other$Species.n),N=other$oth.N,W=other$W)

#tapply(other$W*other$N,list(other$Species.n,other$Year),sum)

ol<-subset(other,Year==ly.VPA & Species.n %in% as.factor(seq(1,noth)),select=-Year,drop=T)
tapply(ol$W*ol$N,list(ol$Species),sum)

l.set<-dim(ol)[1]

oo<-data.frame(Species.n=rep(ol$Species.n,ny),Age=rep(ol$Age,ny),Quarter=rep(ol$Quarter,ny),N=rep(ol$N,ny),
              W=rep(ol$W,ny),Year=as.factor(rep(seq(fy.for,ly.for),each=l.set)))

other<-rbind(other,oo)

b<-tapply(other$N*other$W,list(other$Species.n,other$Year),sum)   # just checking
#barplot(b)

file<-file.path(data.path,'summary.out')
s<-read.table(file,header=TRUE)
s<-subset(s,select=-c(M1,M2,M,F,Z,N.bar,C.hat,C.obs,weca,Yield,propmat,BIO,SSB))
s<-data.frame(subset(s,select=-west),W=s$west)
#head(s)
#tapply(s$W,list(s$Species.n,s$Year),mean)
so<-rbind(other,s)

#tapply(so$W,list(so$Species.n,so$Year),mean)

#b<-tapply(so$N*so$W,list(so$Species.n,so$Year),sum)   # just checking
#barplot(b)

# just because Alex is using an old version
Read.species.names<-function(dir=data.path)
{
  file<-file.path(dir,'Species_names.in')
  s<-readLines(file)
  for (i in (1:10)) s<-sub('_',' ',s)
  s<-sub('[[:space:]]+$', '', s)
}
sp<-Read.species.names()
sp<-sp[1:nsp]

file<-file.path(data.path,'mcout_N.out')
N<-read.table(file,header=TRUE)
N2<-aggregate(N$N,list(Species.n=N$Species.n,Year=N$Year,Quarter=N$Quarter,Age=N$Age),mean)
names(N2)<-c("Species.n","Year","Quarter","Age","N")

w2<-subset(west,Year==ly.VPA & W>0 & Species.n %in% as.factor(seq((noth+1),nsp)) ,select=-Year)
dim(w2)
 head(w2)

NW<-merge(N2,w2)

#tapply(NW$N*NW$W,list(NW$Species.n,NW$Year),sum)   # just checking

#tapply(NW$W,list(NW$Species.n,NW$Year),mean)   # just checking

all<-rbind(so,NW)
#tapply(all$N*all$W,list(all$Year,all$Species,all$Quarter),sum)   # just checking

NW<-merge(all,lw)  # add l-w relation
sp<-data.frame(sp)
ssp<-data.frame(Species.n=as.factor(seq(1,23)),Species=sp$sp)

NWL<-merge(ssp,NW)  # add species names
head(NWL)

#NW<-subset(NW,b>2,drop=T) # minus birds
#tapply(NWL$N*NWL$W,list(NWL$Year,NWL$Species),sum)   # just checking

NWL<-data.frame(NWL,L=(NWL$W/NWL$a)^(1/NWL$b)/10,NW=NWL$N*NWL$W)
NWL<-data.frame(NWL,size=ifelse(NWL$L>40," >40","<=40"))

a<-tapply(NWL$L,list(NWL$Year,NWL$Quarter,NWL$Species,NWL$Age),mean)   # just checking
round(a["2005","1",,])
a<-tapply(NWL$W,list(NWL$Year,NWL$Quarter,NWL$Species,NWL$Age),mean)   # just checking
round(a["2005","1",,],digits=3)

#incl.sp<-c("Fulmar","Guillemot","Her. Gull","Kittiwake","GBB. Gull","Gannet","Puffin","Razorbill","R. radiata",
#            "G. gurnards","W. mackerel", "N. mackerel", "W.horse mac", "N.horse mac","Cod","Whiting","Haddock",
#            "Saithe","Herring","Sandeel","Nor. pout","Plaice","Sole")

incl.sp<-c("R. radiata",
            "G. gurnards","W. mackerel", "N. mackerel", "W.horse mac", "N.horse mac","Cod","Whiting","Haddock",
            "Saithe","Herring","Sandeel","Nor. pout","Plaice","Sole")

#incl.sp<-c("Cod","Whiting","Haddock","Saithe","Nor. pout","Plaice","Sole")
#incl.sp<-c("Cod","Haddock","Saithe","Plaice")

#incl.sp<-c("R. radiata","G. gurnards","W. mackerel", "N. mackerel", "W.horse mac", "N.horse mac")

ploteco<-function(q=1){
  out<-subset(NWL, Species %in% incl.sp & Quarter==q)
  NP<-aggregate(out$NW,list(Year=out$Year,Quarter=out$Quarter,size=out$size),sum)
  NP.all<-aggregate(out$NW,list(Year=out$Year,Quarter=out$Quarter),sum)
  names(NP.all)<-c("Year","Quarter","sum")
  NP.prop<-merge(NP,NP.all)
  NP.prop<-data.frame(NP.prop,prop=NP.prop$x/NP.prop$sum)
  b<- tapply(NP.prop$prop,list(NP.prop$size,NP.prop$Year),sum)
  b[is.na(b)]<-0
  barplot(b,col=c("red","white"),main=paste("Q",q))
  abline(h=0.3)
  abline(h=0.2)
  abline(h=0.1)

}

cleanup()

dev<-"wmf"
#dev<-"screen"
nox<-2
noy<-2
newplot(dev,nox,noy,Portrait=TRUE,w8=9,w11=11);
ploteco(1)
ploteco(2)
ploteco(3)
ploteco(4)

cleanup()
q<-1
  out<-subset(NWL, Species %in% incl.sp & Quarter==1 & Year %in% c(1975,1985,1995,2000,2005,2010))
  NP<-aggregate(out$NW,list(Year=out$Year,Quarter=out$Quarter,Species=out$Species,size=out$size),sum)
  NP.all<-aggregate(out$NW,list(Year=out$Year,Quarter=out$Quarter,Species=out$Species),sum)
  names(NP.all)<-c("Year","Quarter","Species","sum")
  NP.prop<-merge(NP,NP.all)
  NP.prop<-data.frame(NP.prop,prop=NP.prop$x/NP.prop$sum)
  b<- tapply(NP.prop$prop,list(NP.prop$size,NP.prop$Year,NP.prop$Species),sum)
  b[is.na(b)]<-0
op<-arr2dfny(b)
prop<-data.frame(size=op$index.1,Year=op$index.2,Species=op$index.3,prop=op$y)
barchart(prop~Year|Species,groups=size,stack=T,data=prop,ylab='Proportion')


#!/usr/bin/env Rscript

##measuring runtime
ptm <- proc.time()

cat("enter path:")
pathname <- scan("stdin", character(), n=1)
setwd(pathname)
##setup, read ab1 file for peaks
library(sangerseqR)

cat("enter file name:")
filename <- scan("stdin", character(), n=1)
data1 <- read.abif(filename)
loclist <- data1@data$PLOC.2
Alist = c()
Clist = c()
Glist = c()
Tlist = c()
for (locnum in loclist){
	Glist <- append(Glist, (data1@data$DATA.9[locnum]))
	Alist <- append(Alist, (data1@data$DATA.10[locnum]))
	Tlist <- append(Tlist, (data1@data$DATA.11[locnum]))
	Clist <- append(Clist, (data1@data$DATA.12[locnum]))}
calllist = c()

##the readout for each nt is a 4 digit number
sanger1 <- sangerseq(data1)
refseq <- primarySeq(sanger1, string = TRUE)

##locating a sequence before the cutsite (should be uniform), the actual compared sequence will be 30bp downstream
library(stringr)
site1 <- str_locate(refseq, "CGATCCTGCTTT")[2]
site31 <- site1 + 30
site40 <- site1 +39

##threshold maybe tuned for your needs
##thresh=0.05
##or autothreshold can be ran
maxA = max(Alist[site1:(site40+10)])
maxC = max(Clist[site1:(site40+10)])
maxG = max(Glist[site1:(site40+10)])
maxT = max(Tlist[site1:(site40+10)])
signal1 = c()
for (i in site1:(site40+15)){
	signal1 = rbind(signal1, (c(Alist[i]/maxA, Clist[i]/maxC, Glist[i]/maxG, Tlist[i]/maxT)))
	}
signal2 = sort(signal1)
dropmax = 0
cutnum = 0
for (i in 1:(length(signal2)-1)){
	if (signal2[i]>0.01 & signal2[i]<0.25){
		drop1 = signal2[i+1]/signal2[i]
		if (drop1 > dropmax){
			cutnum = signal2[i+1]
			dropmax = drop1
			}
		}
	}
print(cutnum)
thresh1 <- c(cutnum*maxA,cutnum*maxC,cutnum*maxG,cutnum*maxT)
print(thresh1)
for (i in 1:length(loclist)){
	call1 <- 0
	if (Alist[i] >= thresh1[1]){
		call1 <- call1 + 1000}
	if (Clist[i] >= thresh1[2]){
		call1 <- call1 + 100}
	if (Glist[i] >= thresh1[3]){
		call1 <- call1 + 10}
	if (Tlist[i] >= thresh1[4]){
		call1 <- call1 + 1}
	calllist <- append(calllist, call1)
	}
refseqfrag <- unlist(calllist[site31:site40])
seqscore <- str_c(refseqfrag,collapse="")

##enter wildtype sequence around the area of interest here
wtseq <- readChar("ref.txt",file.info("ref.txt")$size)
sitewt <- str_locate(wtseq, "CGATCCTGCTTT")[2]

##investigating the -10-+9 range of indels
for (i in 0:20){
	fragname = paste("frag",i,sep="")
	assign(fragname, unlist(strsplit(substr(wtseq, sitewt+20+i, sitewt+29+i),split="")))}
counter <- 0

##searching for up to 4 seqs to match the sequencing results, usually around 1-2 min
for (i in 0:18){
	fi <- get(paste("frag",i,sep=""))
	for (j in i:19){
		fj <- get(paste("frag",j,sep=""))
		for (k in j:20){
			fk <- get(paste("frag",k,sep=""))
			for (n in k:20){
				fn <- get(paste("frag",n,sep=""))
						temp = c()
						vartempscore = c()
						for (m in 1:10){
							score <- 0
							temp <- append(temp, paste(fi[m],fj[m],fk[m],fn[m],sep=""))
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],sep=""),"A")){
								score <- score + 1000
								}
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],sep=""),"C")){
								score <- score + 100
								}
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],sep=""),"G")){
								score <- score + 10
								}
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],sep=""),"T")){
								score <- score + 1
								}
							vartempscore <- append(vartempscore, score)
							varname = paste("var",i,j,k,n,sep="a")
							varscore = paste("varscore",i,j,k,n,sep="a")
							assign(varname, temp)
							assign(varscore,vartempscore)
							}
						tempstr <- str_c(vartempscore,collapse="")
						##print(tempstr)
						if (tempstr == seqscore){
						print (varname)
						counter <- counter +1
						}
					}
				}
			}
		}
print("for 4 variables search:")
print(counter)

##if 4 seq failed, a much more intensive search of up to 6 seqs will start, 30min to 1hour
if (counter == 0){
for (i in 0:20){
	fragname = paste("frag",i,sep="")
	assign(fragname, unlist(strsplit(substr(wtseq, sitewt+20+i, sitewt+29+i),split="")))}
site31 <- site1 + 30
site35 <- site1 +34
refseqfrag <- unlist(calllist[site31:site40])
seqscore <- str_c(refseqfrag,collapse="")
for (i in 0:18){
	fi <- get(paste("frag",i,sep=""))
	for (j in i:19){
		fj <- get(paste("frag",j,sep=""))
		for (k in j:20){
			fk <- get(paste("frag",k,sep=""))
			for (n in k:20){
				fn <- get(paste("frag",n,sep=""))
				for (p in n:20){
					fp <- get(paste("frag",p,sep=""))
					for (q in p:20){
						fq <- get(paste("frag",q,sep=""))
						temp = c()
						vartempscore = c()
						for (m in 1:10){
							score <- 0
							temp <- append(temp, paste(fi[m],fj[m],fk[m],fn[m],fp[m],fq[m],sep=""))
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],fp[m],fq[m],sep=""),"A")){
								score <- score + 1000
								}
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],fp[m],fq[m],sep=""),"C")){
								score <- score + 100
								}
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],fp[m],fq[m],sep=""),"G")){
								score <- score + 10
								}
							if (str_detect(paste(fi[m],fj[m],fk[m],fn[m],fp[m],fq[m],sep=""),"T")){
								score <- score + 1
								}
							vartempscore <- append(vartempscore, score)
							varname = paste("var",i,j,k,n,p,q,sep="a")
							varscore = paste("varscore",i,j,k,n,p,q,sep="a")
							assign(varname, temp)
							assign(varscore,vartempscore)
							}
						tempstr <- str_c(vartempscore,collapse="")
						##print(tempstr)
						if (tempstr == seqscore){
						print (varname)
						counter <- counter +1
						}
					}
				}
			}
		}
	}
}
print(counter)
}
proc.time() - ptm


#density plot plots density of half-life in both conditions.
#the data is the combined output from rifi_statistics
#value is the maximum value of half-life to be plotted
#conditions are your conditions
density_plot <- function(data, value, condition){
pdf("density_HL.pdf")
ggplot(filter(data, HL_mean_fragment < value),
       aes(HL_mean_fragment, color = cdt)) +
    geom_density(alpha = 0.2) +
    geom_vline(data = data,
               mapping = aes(xintercept =
                                 mean(na.omit(HL_mean_fragment)), color = cdt)) +
    scale_color_discrete(labels = c(condition[1], condition[2])) +
    scale_x_continuous(breaks = seq(0, value, by = 4), limits = c(0, value)) +
    labs(x = "Half-life [min]\n") +
    ggtitle(paste("Decay density in", condition[1], "vs", condition[2])) +
    theme(
        panel.background = element_blank(),
        axis.line = element_line(colour = "dimgrey"),
        legend.title = element_blank(),
        plot.title = element_text(size = 12, face = "bold", hjust = .5)
    )
dev.off()
}


corpus = tm::Corpus(tm::VectorSource(tweets_primary_df$word))

# Handling UTF-8 encoding problem from the dataset
corpus.cleaned <- tm::tm_map(corpus, tm::removeWords, tm::stopwords('english')) # Removing stop-words
corpus.cleaned <- tm::tm_map(corpus.cleaned, tm::stemDocument, language = "english") # Stemming the words
corpus.cleaned <- tm::tm_map(corpus.cleaned, tm::stripWhitespace) # Trimming excessive whitespaces

# Building the feature matrices
tdm <- tm::DocumentTermMatrix(corpus.cleaned)
tdm.tfidf <- tm::weightTfIdf(tdm)
# We remove A LOT of features. R is natively very weak with high dimensional matrix
tdm.tfidf <- tm::removeSparseTerms(tdm.tfidf, 0.999)
# There is the memory-problem part
# - Native matrix isn't "sparse-compliant" in the memory
# - Sparse implementations aren't necessary compatible with clustering algorithms
tfidf.matrix <- as.matrix(tdm.tfidf)
# Cosine distance matrix (useful for specific clustering algorithms)
dist.matrix = proxy::dist(tfidf.matrix, method = "cosine")

truth.K = 20
clustering.kmeans <- kmeans(tfidf.matrix, truth.K)

cluster_kmeans = as.data.frame(clustering.kmeans[["cluster"]]) %>%
  rownames_to_column() %>%
  rename(tweet_n = rowname)

cluster_kmeans$tweet_n = as.numeric(cluster_kmeans$tweet_n)
tweets_primary_df_kmeans = inner_join(cluster_kmeans,tweets_primary_df)
saveRDS(tweets_primary_df_kmeans,"data/tweets_primary_kmeans_df.rds")

cluster_1_kmeans = tweets_primary_df_kmeans %>% filter(`clustering.kmeans[["cluster"]]` == 1)
sentiment_key_word_subsets(df = cluster_1_kmeans)
sentiment_key_word_subsets = function(df) {
  corpus = corpus(df$word)
  token_word = data.frame(text = corpus, stringsAsFactors = FALSE) %>% unnest_tokens(word, text)
  senti_word = inner_join(token_word, get_sentiments("nrc")) %>%
    count(sentiment)
  senti_word$percent = (senti_word$n / sum(senti_word$n)) * 100
  ggplot(senti_word, aes(sentiment, percent)) +
    geom_bar(aes(fill = sentiment), position = 'stack', stat = 'identity') +
    coord_flip() +
    theme(
      plot.background = element_rect(fill = "black", colour = NA),
      panel.background = element_rect(fill = "black", colour = NA),
      legend.position = "none",
      axis.text = element_text(color = "white"),
      text = element_text(
        size = 16,
        family = "times",
        colour = "white"
      ),
    )
}

topic_frequent_emo_lex_trigger = function(topic_n)
{
  topic = tweets_primary_df_kmeans %>%
    filter(`clustering.kmeans[["cluster"]]` == topic_n)
  topic1_emo_lex = as.data.frame(unlist(topic$emo_lex_trigger)) %>%
    rename(word = 1) %>%
    count(word, sort = TRUE)
  DT::datatable(topic1_emo_lex, options = list(pageLength = 25))
}
topic_frequent_emo_lex_trigger(topic_n = 5)