library('stringr')
library('Cairo')
library('MASS')
library('mixtools')
library('Hmisc')

files = list.files('.','*.tsv')
games = read.table('indie.tsv',quote="",sep='\t',header=T,stringsAsFactors=F,fill=T)
games[,'publisher'] = 'Indie'
games[,'group'] = 'Indie'

for(file in files){
  publisher = str_extract(file,"^[^\\.]+")
  if(file != 'indie.tsv'){
    new_data = read.table(file,quote="",sep='\t',header=T,stringsAsFactors=F,fill=T)
    games = games[!(games$Idx %in% new_data$Idx), ]
  }
}

# CLEAN UP #
# Delete rows with inconsistent date format (mostly "MMM D[D], YYYY")
games=games[grep("^\\w\\w\\w \\d+, \\d\\d\\d\\d$",games$Released),]

# Bin into month and year, restrict to 2013-2014
months = 1:12
names(months) = c("jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec")

games[,'release.month'] = months[tolower(str_extract(games$Released,"^\\w\\w\\w"))]
games[,'release.year'] = as.numeric(str_extract(games$Released,"\\d\\d\\d\\d$"))
games = games[games$release.year %in% c(2013,2014,2015),]

# get number of owners
games[,'owners.numeric'] = as.numeric(str_replace_all(str_extract(games$Owners,"^[\\d,]+"),',',''))

# remove F2P and games under 2.99
games = games[games$Price != 'Free',]
games[,'price.numeric'] = round(as.numeric(str_replace(games$Price,"\\$","")))
games = games[games$price.numeric>=3,]

# pull out the userscore
games[,'rating'] = as.numeric(str_replace(games$Userscore,"% \\([\\dNA/%]+\\)",""))
games$rating[is.na(games$rating)] = 0

# THE INDIEPOCOLYPSE! AHHHHH!
games[,'yearmonth'] = games$release.month
games$yearmonth[games$release.year==2014] = games$yearmonth[games$release.year==2014] + 12
games$yearmonth[games$release.year==2015] = games$yearmonth[games$release.year==2015] + 24
games = games[games$yearmonth<32,]

released = 1:31
are_good = 1:31
for(i in 1:31){
  includes = games$yearmonth==i
  released[i] = sum(includes)
  are_good[i] = sum(includes & games$rating>69)
}

# Rate of release
CairoPDF('steam_release_rate',width=9,height=3)
par(mfrow=c(1,2))
prefixes = c('','Good')
minima   = c(-1, 69)
for(i in 1:2){
  h = hist(games$yearmonth[games$rating>minima[i]],seq((1:31)-.5),plot=F)
  plot(h$mids,h$counts,main=paste(prefixes[i],"Indie games released by month"),xlab="Release Date",xaxt='n',
       ylab="Games released",type='l',pch=16,col='dodgerblue',lwd=3)
  axis(1,at=c(1,13,25,31),label=c('2013','2014','2015','July'))
}
dev.off()

CairoPDF('steam_success_rate',width=6,height=9)
hists = list('2013'=0,'2014'=0,'2015'=0)
colors = c('red','dodgerblue','black')
years = 2013:2015
par(mfrow=c(3,2))
for(i in 1:3){
  y=years[i]
  col = colors[i]
  owners = games$owners.numeric[games$owners.numeric>0 & games$release.year==y]
  hist(owners, 100, main=paste("Indie success (",y,')',sep=''),xlab="Owners per Game",ylab="Number of Games" )

  owners = log10(games$owners.numeric[games$owners.numeric>0 & games$release.year==y])
  h=hist(owners, 20,plot=F )
  plot(h$mids,h$density, main=paste("Indie success (transformed, ",y,')',sep=''),xlab="log(Owners per Game)",ylab="Fraction of Games")
  normfit = fitdistr(owners,'normal')
  normaldat = dnorm(h$mids,mean=normfit$estimate[1],sd=normfit$estimate[2])
  lines(h$mids,normaldat,col=col,lwd=2)
  legend('topright',c(paste('mean =',round(normfit$estimate[1],2)),
                      paste('sd   =',round(normfit$estimate[2],2))),
         text.col=col,bty='n')
  hists[[y]]=h
}
dev.off()

CairoPDF('steam_swamp',width=4,height=3)
plot(hists[[2015]]$mids,hists[[2015]]$counts,type='l',lwd=3,yaxt='n',
     main="Indie success decreases by year",xlab="log(Owners per Game)",col=colors[3],
     ylab="Number of Games" )
lines(hists[[2013]]$mids,hists[[2013]]$counts,type='l',lwd=3,col=colors[1])
lines(hists[[2014]]$mids,hists[[2014]]$counts,type='l',lwd=3,col=colors[2])
axis(2,at=c(0,50,100))
legend('topright',c('2013','2014','2015'),text.col=colors,bty='n')
dev.off()

CairoPDF('steam_success_quality',width=4,height=4)
plot(NA,NA,ylim=c(0,35),xlim=c(2.5,6.5),ylab="Number of Games",
     xlab="log(Owned)",main=paste("Success of good indie games",sep=""))
for(i in 1:3){
  y = years[i]
  # Need distributions of 'success' for good and bad games for both years
  good = log10(games$owners.numeric[games$owners.numeric>0 & games$release.year==y & games$rating>69])
  bad  = log10(games$owners.numeric[games$owners.numeric>0 & games$release.year==y & games$rating<70])
  h.good = hist(good,seq(from=2.5,to=7,by=.25),plot=F)
  h.bad  = hist(bad ,seq(from=2.5,to=7,by=.25),plot=F)
  ymax   = max(c(h.good$counts,h.bad$counts))
  xlims  = range(c(good,bad))
  lines(h.good$mids,h.good$counts,ylim=c(0,ymax),xlim=c(2.5,6.5),lwd=2,col=colors[i])
  #lines(h.bad$mids,h.bad$counts,lwd=2,lty=3,col=colors[i])
}
#legend('topright',c('good','others'),bty='n',text.col='gray',col='gray',lty=c(1,3))
legend('topleft',c('2013','2014','2015'),text.col=colors,bty='n')
dev.off()

CairoPDF("Indiepocolypse",width=12,height=5)
par(mfrow=c(1,2))
postfixes = c('','(good games)')
for(i in 1:2){
  x = games$yearmonth[games$rating>minima[i]]
  y = log10(games$owners.numeric[games$rating>minima[i]])
  plot(x,y,pch=16,cex=.5,col=rgb(0,0,0,.3),ylim=c(2,7),
       main=paste("Success vs. release month",postfixes[i]),xlab="Release Date",ylab="log(Owners)", xaxt='n')
  axis(1,at=c(1,13,25,31),label=c('2013','2014','2015','July'))
  medians = 1:31
  upperq  = 1:31
  lowerq  = 1:31
  total   = 1:31
  for(j in 1:31){
    medians[j] = median(games$owners.numeric[games$yearmonth==j & games$rating>minima[i]])
    upperq[j]  = quantile(games$owners.numeric[games$yearmonth==j & games$rating>minima[i]],.75)
    lowerq[j]  = quantile(games$owners.numeric[games$yearmonth==j & games$rating>minima[i]],.25)
    total[j]   = sum(games$owners.numeric[games$yearmonth==j & games$rating>minima[i]])
  }
  points(1:31,log10(medians),pch=16,cex=1,col='red')
  points(1:31,log10(upperq),pch=3,cex=1,col='red')
  points(1:31,log10(lowerq),pch=3,cex=1,col='red')
  points(1:31,log10(total),pch=15,cex=1,col='blue')
  fit = lm(y~x)
  slope = fit$coefficients[2]
  intercept = fit$coefficients[1]
  rsq   = summary(fit)$r.squared
  #abline(b=slope,a=intercept)
  correlation = rcorr(x,y,'pearson')$r[1,2]
  pvalue      = rcorr(x,y,'pearson')$P[1,2]
  legend('bottomleft',c(paste('pc =',round(correlation,3)),paste('-log(P) =',round(-log10(pvalue),2))),bty='n')
}

dev.off()


#####################################
# Collection of functions to be used
#####################################
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Logit and Inverse logit (for back-tranforming logit fits)
logit<-function(x){log(x/(1-x))}
logit_tr<-function(x){exp(x)/(1+exp(x))}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Transparent fills
alpha.col<-function(col,alpha){
  col<-as.vector(col2rgb(col)/255)
  rgb(col[1],col[2],col[3], alpha )
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Consistent letter positions for figure labels
fig.let <- function(label, location="topleft", x=NULL, y=NULL,
                    offset=c(0, 0), ...) {
  if(length(label) > 1) {
    warning("length(label) > 1, using label[1]")
  }
  if(is.null(x) | is.null(y)) {
    coords <- switch(location,
                     topleft = c(0.015,0.98),
                     topcenter = c(0.5525,0.98),
                     topright = c(0.985, 0.98),
                     bottomleft = c(0.015, 0.02),
                     bottomcenter = c(0.5525, 0.02),
                     bottomright = c(0.985, 0.02),
                     c(0.015, 0.98) )
  } else {
    coords <- c(x,y)
  }
  this.x <- grconvertX(coords[1] + offset[1], from="nfc", to="user")
  this.y <- grconvertY(coords[2] + offset[2], from="nfc", to="user")
  text(labels=label[1], x=this.x, y=this.y, xpd=T, ...)
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Which elements are not in the vector
'%!in%' <- function(x,y)!('%in%'(x,y))
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Are all elements non-NA
NoNA<-function(x){!any(is.na(x))}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Are all elements NA
AllNA<-function(x){all(is.na(x))}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ISOdate and ISOdatetime only work for specific combinations, so create own
coll<-function(x,sel,sep='-'){if(length(sel)>0){apply(x,1,paste0,collapse=sep)}}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Geometric mean
gmean<-function(x){exp(mean(log(x[!is.infinite(x)]),na.rm=TRUE))}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Capitalize first letter of taxon names
firstup <- function(x) {substr(x, 1, 1) <- toupper(substr(x, 1, 1));x}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Fix taxon names
FixNames<-function(dat){
  dat$taxon<-gsub(' ','_',dat$taxon)
  dat$taxon<-firstup(dat$taxon)
  dat<-subset(dat,taxon!='')
  dat$taxon<-word(dat$taxon,1,2,sep='_') # Remove subspecies names
  return(dat)
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Posterior sampling to get confidence interval for min to max range of a smooth term
CIonDiff_postSamp <- function(fit, focal.term, subset=NULL, probs=c(0.025, 0.5, 0.975), samps=10000, plot.samps=FALSE){
  require(MASS)
  newdata <- fit$model[,-1]
  if(!is.null(subset)){
      newdata <- newdata[subset,]
  }
  if(nrow(newdata)<1000){
    newdata <- newdata[rep_len(seq_len(nrow(newdata)), 1000), ] # ensure there are at least 1000 points
  }
  # min and max of focal term
  foc.rng <- range(newdata[,focal.term])
  # 1,000 equally spaced points along focal term range.
  # The other covariates can be fixed to anything since BY ASSUMPTION,
  # they don't interact with the focal term
  newdata[,focal.term] <- seq(foc.rng[1],foc.rng[2],length=nrow(newdata))

  Xp <- predict(fit, newdata=newdata, type="lpmatrix") # extract basis function etc. values at locations defined above
  Xp = Xp[,grep(focal.term, colnames(Xp))] # subset to only consider focal term

  beta <- coef(fit); beta = beta[grep(focal.term,names(beta))] # posterior mean vector for s(x1) parameters
  Vb <- vcov(fit); Vb = Vb[grep(focal.term,rownames(Vb)), grep(focal.term,colnames(Vb))] # posterior covar. matrix for s(x1) params.

  n <- samps # number of posterior samples to draw
  br <- mvrnorm(n,beta,Vb) ## simulate n rep coef vectors from posterior
  MinMaxRange <- rep(NA,n)
  for (i in 1:n) { ## loop to get trough to peak diff for each sim
    pred <- Xp %*% br[i,] ## curve for this replicate
    if(plot.samps){
      if(i == 1) plot(pred ~ newdata[,focal.term])
      if(i > 1 & i < 100) lines(pred ~ newdata[,focal.term])
    }
    MinMaxRange[i] <- max(pred)-min(pred) ## range for this curve
  }
  quantile(MinMaxRange, probs)
}

# CI_postSamp(fit, 'x1',plot.samps=T)
# exp(CI_postSamp(fit, 'x1'))
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Gradient-filled polygon
shaded.polygon <- function(x, y, se, col=c('blue','red'), n=500, breaks=NULL,horiz=TRUE) {
  y_high <- y + se
  y_low <- y - se

  if(horiz){
    if(!is.null(breaks)){
      x_ats <- breaks
      height <- unique(diff(breaks))
    }else{
      height <- diff(c(min(x),max(x)))/(n)
      x_ats <- seq(min(x), max(x), height)
    }
    pal <- if(!is.function(col)) colorRampPalette(col)(n) else col(n)[x_ats]
    # plot rectangles to simulate colour gradient
    sapply(seq_len(n),
           function(i) {
             rect(max(min(x), x_ats[i] - height), min(y_low),
                  min(max(x), x_ats[i] + height), max(y_high),
                  col=pal[i], border=NA)
           })
  }
  if(!horiz){
    if(!is.null(breaks)){
      y_ats <- breaks
      height <- unique(diff(breaks))
    }else{
      height <- diff(c(min(y),max(y)))/(n)
      y_ats <- seq(min(y), max(y), height)
    }
    pal <- if(!is.function(col)) colorRampPalette(col)(n) else col(n)[y_ats]
    # plot rectangles to simulate colour gradient
    sapply(seq_len(n-1),
           function(i) {
             rect(min(x), max(min(y_low), y_ats[i] - height),
                  max(x), min(max(y_high), y_ats[i] + height),
                  col=pal[i], border=NA)
           })
  }
  # plot white polygons representing the inverse of the area of interest
  e <- par("usr")
  polygon(c(x[1], x, x[length(x)]),
          c(max(y_high), y_high, max(y_high)),
          col='white', border='white')
  polygon(c(x[1], x, x[length(x)]),
          c(min(y_low), y_low, min(y_low)),
          col='white', border='white')
  polygon(c(e[1], min(x), min(x), e[1]),
          c(e[3], e[3], e[4], e[4]),
          col='white', border='white')
  polygon(c(e[2], max(x), max(x), e[2]),
          c(e[3], e[3], e[4], e[4]),
          col='white', border='white')
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# For violin plot
data_summary <- function(x) {
  n <- length(x)
  m <- mean(x,na.rm=T)
  if(n==1){ ymin<-ymax<-m} else{
    ymin <- m-sd(x,na.rm=T)
    ymax <- min(m+sd(x,na.rm=T),100,na.rm=T)
  }
  return(c(y=m,ymin=ymin,ymax=ymax))
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                    ncol = cols, nrow = ceiling(numPlots/cols))
  }

 if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Following from
# https://github.com/lukejharmon/traitathon/blob/master/EOLtraithack/traitbankSource.R

##  --------------------------------- ##
##                                    ##
##       TraitBank Source Code        ##
##    Very Primitive API Interface    ##
##         written by B.Banbury       ##
##             18 Sept 14             ##
##                                    ##
##  --------------------------------- ##

#
# require(Reol)
# require(rjson)
# require(RCurl)
# require(ape)
#
# DownloadEOLtraits <- function (pages, to.file = TRUE, MyKey = NULL, verbose = TRUE, cache=2419200, ...) {
#   #this will download EOL trait data json either to file or to R console (user)
#   if (Sys.getlocale("LC_ALL") == "C")
#     warning("Sys.getlocale is set to C. In order to read UTF characters, you need to set the locale aspect to UTF-8 using Sys.setlocale")
#   EOLpages <- vector("list", length = length(pages))
#   for (i in sequence(length(pages))) {
#     pageNum <- pages[i]
#     #http://eol.org/api/traits/328598?cache_ttl=2419200 #cache_ttl is the amount of seconds you are willing to wait
#     web <- paste("http://eol.org/api/traits/", pageNum, "?cache_ttl=", cache, sep = "")
#     if (!is.null(MyKey))
#       web <- paste(web, "&key=", MyKey, sep = "")
#     if (to.file) {
#       write(getURL(web, ...), file = paste("eol", pages[i], ".xml", sep = ""))
#       if (verbose)
#         print(paste("Downloaded ", "eol", pages[i], ".json", sep = ""))
#     }
#     else {
#       EOLpages[[i]] <- getURL(web, ...)
#       names(EOLpages)[[i]] <- paste("eol", pages[i], sep = "")
#       if (verbose)
#         print(paste("eol", pages[i], " saved as R object", sep = ""))
#     }
#     Sys.sleep(1)
#   }
#   if (to.file)
#     return(paste("eol", pages, ".xml", sep = ""))
#   else return(EOLpages)
# }
# #whaledata <- DownloadEOLtraits(328574, to.file=FALSE)
#
# #whaleJSON <- rjson::fromJSON(file="~/eol328547.xml")  #files work
# #whaleJSON <- rjson::fromJSON(json_str=unlist(whaledata))  #works
#
#
# ReadJSON <- function(rawJSON){
#   #this will parse and unlist a json file from EOL (internal)
#   if(regexpr("^eol[0-9]+.xml$", rawJSON) > 0)  #it is a file
#     return(unlist(rjson::fromJSON(file=unlist(rawJSON))$`@graph`))
#   return(unlist(rjson::fromJSON(json_str=unlist(rawJSON))$`@graph`))
# }
# #ReadJSON(whaledata)
#
#
# WhichTraits <- function(JSON){
#   #find which trait values are available for this JSON (user)
#   whichTraits <- NULL
#   for(i in sequence(length(JSON))){
#     j <- ReadJSON(JSON[[i]])
#     tt <- paste(j[which(names(j) == "dwc:measurementType.rdfs:label.en")])
#     whichTraits <- c(whichTraits, tt)
#   }
#   return(unique(whichTraits))
# }
# #WhichTraits(whaledata)
# #WhichTraits(allwhales)
#
#
# GetLocationInJSON <- function(traitOfInterest, JSON){
#   #this will find where in the json your trait is (internal)
#   if(any(traitOfInterest == WhichTraits(JSON))){
#     j <- ReadJSON(JSON)
#     placesOfInterest <- grep(traitOfInterest, j)
#     return(placesOfInterest)
#   }
#   return("NO matches")
# }
# #GetLocationInJSON("body mass", whaledata)
#
#
# GetTaxonName <- function(JSON){
#   #this function will retrieve a taxon name from the JSON (internal)
#   j <- ReadJSON(JSON)
#   return((j[[grep("scientificName", names(j))]]))
# }
# #GetTaxonName(whaledata)
#
#
# GetDataforOne <- function(traitOfInterest, JSON){
#   #this will return a data frame with hacky trait info (internal)
#   #it will only work if the data is in the same order...we can/should fix this later
#   if(length(GetLocationInJSON(traitOfInterest, JSON)) > 0){
#     locs <- GetLocationInJSON(traitOfInterest, JSON)
#     if(locs[1] != "NO matches"){
#       datamat <- matrix(nrow=length(locs), ncol=5)  #ncols hard coded...no likey
#       tax <- GetTaxonName(JSON)
#       j <- ReadJSON(JSON)
#       for(i in sequence(length(locs))){
#         datamat[i,] <- c(tax, j[locs[i]], j[locs[i]+2], j[locs[i]+3], j[locs[i]+5])
#       }
#     }
#     else
#       return(NULL)
#   }
#   return(as.data.frame(datamat, stringsAsFactors=FALSE))
# }
# #GetDataforOne("body mass", whaledata)
# #GetDataforOne("total life span", whaledata)
#
# GetData <- function(traitOfInterest, JSON, chatty=FALSE){
#   #this function rbinds all the species pages together (user)
#   tot <- NULL
#   for(i in sequence(length(JSON))){
#     if(chatty)
#       print(paste("file", i))
#     inddata <- GetDataforOne(traitOfInterest, JSON[[i]])
#     tot <- rbind(tot, inddata)
#   }
#   return(tot)
# }
# #GetData("body mass", whaledata)
#
# # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


# Formatting the 2011 phenotype data: NAM and F1
# Jinliang Yang
# Jan 19th, 2012
# log: change Genotype [. to ""]

setwd("~/Documents/Heterosis_GWAS/pheno2011")

#############################################################
# Check the data completeness and correct the notes
#Notes: Two replications in Curtiss and Johnson
#Curtiss: 4651-6100
#Johnson J1251-J2350

file1 <- read.csv("data/rawdata/LL_cob.test.csv")
dim(file1)
#[1] 8773   10 | [1] 8286   11

nam <- subset(file1, Note.y!="Diallel" & Note.y!="NAM Filler");
dim(nam)
#[1] 5806   10 | [1] 5467   11 | [1] 5828    8
summary(nam)

###########################################################
### Delete duplicated input and missing data
barcode <- nam[duplicated(nam$Barcode),]$Barcode
nam[nam$Barcode%in%barcode,]
length(barcode)
# Get ride of 2 duplicated records
nam <- nam[!duplicated(nam$Barcode),]

##########################################################
### checking for outlyers
nam$CL<- as.numeric(as.character(nam$CL));
nam$CD <- as.numeric(as.character(nam$CD));
nam$CW <- as.numeric(as.character(nam$CW));

hist(nam$CL)
hist(nam$CD)
hist(nam$CW)

head(nam[order(nam$CL),])
tail(nam[order(nam$CL),])

idx <- which.max(nam$CW)
nam <- nam[-idx,]

#extreme long ear: removed
nam <- nam[nam$Barcode!="11-5635-22 OP",]
nam <- nam[nam$Barcode!="11-5622-22 OP",]

nambackup <- nam
dim(nam)
#[1] 5801   10
#######################################################

idx0 <- grep(" x B73", nam$Genotype)
sub1 <- nam[idx0,]
sub1$Genotype <- gsub(" x B73", "", sub1$Genotype)
sub1$Genotype <- paste("B73 x ", sub1$Genotype, sep="")

nam2011cob <- rbind(nam[-idx0,], sub1)

#######################################################
### BLUE

namcl <- BLUE(data=nam2011cob, model=CL~Genotype, random=~1|Farm, trait="CL", intercept="B73 x Z001E0002")
namcl$Genotype <- gsub("@", "", namcl$Genotype)

namcd <- BLUE(data=nam2011cob, model=CD~Genotype, random=~1|Farm, trait="CD", intercept="B73 x Z001E0002")
namcd$Genotype <- gsub("@", "", namcd$Genotype)

namcw <- BLUE(data=nam2011cob, model=CW~Genotype, random=~1|Farm, trait="CW", intercept="B73 x Z001E0002")
namcw$Genotype <- gsub("@", "", namcw$Genotype)


#!/usr/bin/env Rscript
#autor:      Joao Sollari Lopes
#local:      University of Reading, Reading, UK
#Rversion:   3.2.3
#criado:     01.03.2010
#modificado: 20.11.2017

# @arg data_file - file with summary of 'real' data (.trg)
# @arg rej_file  - file with rejection step results (.rej)
check_fit <- function(data_file , rej_file){

	#import the .rej file
	abc.rej <- data.matrix(read.table(rej_file))

	#import the .trg files
	target <- data.matrix(read.table(data_file))

	#check target on summstats
    fname <- "../results/check_fit.eps"
    postscript(file=fname,width=7,height=7,colormodel="rgb",horizontal=FALSE,onefile=FALSE,paper="special")
	oldpar <- par(mfrow=c(1,3),xaxt="n",yaxt="n",mar=c(2,2,2,2))
	nparams <- 6
	isstats <- 1
	fsstats <- 3
	for(i in isstats:fsstats){
		hist(abc.rej[,nparams+i],main=i)
		abline(v=target[i],lwd=2,lty=1,col="blue")
	}
	par(oldpar)
	dev.off()
	print("done target check")

}

args = commandArgs(trailingOnly=TRUE)
check_fit(args[1],args[2])


rm(list=ls())
library(dplyr)
library(ggplot2)
library(tidyr)
library(ggpubr)

# set dataset

dataset1 <- "Singhal"
dataset2 <- "SinghalOG"
dataset <- "SinghalOG"

h <- "TvS"

setwd(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset, sep=''))

# Read in data and rename data
load(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset1,"/Calcs_",dataset1,".RData", sep=''))
mLBF1 <- mLBF
mLGL1 <- mLGL
rm(mLBF,mLGL)

load(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset2,"/Calcs_",dataset2,".RData", sep=''))
mLBF2 <- mLBF
mLGL2 <- mLGL
rm(mLBF,mLGL)

## Number of overlapping
length(intersect(mLBF1$Locus,mLBF2$Locus))

# Remove any other from the larger dataset
mLBF1 <- mLBF1[mLBF1$Locus %in% intersect(mLBF1$Locus,mLBF2$Locus),]
mLBF2 <- mLBF2[mLBF2$Locus %in% intersect(mLBF2$Locus,mLBF1$Locus),]

mLGL1 <- mLGL1[mLGL1$Locus %in% intersect(mLGL1$Locus,mLGL2$Locus),]
mLGL2 <- mLGL2[mLGL2$Locus %in% intersect(mLGL2$Locus,mLGL1$Locus),]

GL <- function(df.g,xval.g,xlablab.g,tic.g,lines.g,limit.g,cc.g,title.g){
  GL_hist <- ggplot(data=df.g, aes(x=xval.g)) +
  geom_histogram(binwidth = limit.g*0.01, alpha=1, position="dodge", color=cc.g, fill=cc.g)+
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5, size=16),
        axis.text = element_text(size=10, color="black"),
        text = element_text(size=14),
        legend.title = element_text(size = 12),
        legend.text = element_text(size = 10)) +
  labs(y="Number of Loci",x=xlablab.g)  +
  ggtitle(title.g) +
  coord_cartesian(ylim=ymax, xlim = tic.g) +
  scale_x_continuous(breaks = c(0,tic.g)) +
  scale_y_continuous(breaks = ymax) +
  # geom_vline(xintercept=lines.g,color=c("black"), linetype="dashed", size=0.5) +
  geom_vline(xintercept=c(0),color=c("black"), linetype="dashed", size=0.2)
  return(GL_hist)
}

# Colors
color_S <- "orange"
color_TP <- "springgreen4"
color_AI <- "#2BB07FFF"
color_SA <- "#38598CFF"
color_SI <- "#C2DF23FF"

# you'll have to graph first, then reset this
maxloci <- 600
ymax <- seq(0,maxloci,100)

# Set title and input data
title.1 <- paste(dataset1," - ",h,sep="")
title.2 <- paste(dataset2," - ",h,sep="")
cc.1 <- color_TP
# GL
#df.1 <- mLGL1
#df.2 <- mLGL2
#xval.1 <- mLGL1$TvS
#xval.2 <- mLGL2$TvS

# GL
df.1 <- mLBF1
df.2 <- mLBF2
xval.1 <- mLBF1$TvS
xval.2 <- mLBF2$TvS

xlablab.1 <- 'dGLS values'

xlablab.1 <- '2ln(BF) values'

# Get max min for graph to set x axis values
limit.1 <- 5 + round(max(abs(min(xval.1)),abs(max(xval.1))),-1)
limit.2 <- 5 + round(max(abs(min(xval.2)),abs(max(xval.2))),-1)
max(c(limit.1,limit.2))
limit.1 <- 210
tic.1 <- seq(-limit.1,limit.1,20)
lines.1 <- c(0.5,-0.5)

#quartz()
GL.1 <- GL(df.1,xval.1,xlablab.1,tic.1,lines.1,limit.1,cc.1,title.1)
GL.2 <- GL(df.2,xval.2,xlablab.1,tic.1,lines.1,limit.1,cc.1,title.2)

G.all <- ggarrange(GL.1,GL.2, ncol=1, nrow=2, align="v")
#quartz()
G.all

# For tox add hypoth you mentioned at the beginning
ggsave(paste(dataset,"_histo_",h,"bf.pdf",sep=""), plot=G.all,width = 9, height = 7, units = "in", device = 'pdf',bg = "transparent")