# ConnnectHiCorResiduals.r
# connect regions of high residual correlation
#
library(stringr)
library(fields)
source('~esswein/lib/R/runinfo.R')
source('~esswein/lib/R/midpoint.R')
add.alpha <- function (hex.color.list, alpha) sprintf("%s%02X", hex.color.list, floor(alpha * 256))
ri = runinfo()
if (!exists('do.pdf')) do.pdf = F

# Get list of all subregions of this region:
coord.files = dir('~esswein/science/region/boundary',str_c(region,'.*.coords'),full.names=T)
subs = basename(coord.files)
subs = sub(str_c(region,'.'),'',subs)
subs = sub('coords','',subs)
subs = sub('\\.','',subs)

if (subregion != '') {
  # If subregion was specified, make map only for that subregion
  map.regions = subregion
  file.pdf = sub(str_c(subregion,'.rds'),str_c('ConnnectHiCorResiduals.',subregion,'.pdf'),file.regress)
} else {
  # If subregion was not specified, make maps for whole region and each subregion
  map.regions = subs
  file.pdf = sub('.rds','.ConnnectHiCorResiduals.pdf',file.regress)
  file.pdf = sub('Regress.rds','ConnnectHiCorResiduals.pdf',file.regress)
}
file.rds = sub('\\.pdf','.rds',file.pdf)

dat.rgr = readRDS(file.regress)

site.data = dat.rgr$site.data
site.df = dat.rgr$site.df
sites = unique(site.df$name)
dates = unique(sort(site.df$yyyymmddhhmm))
n.site = length(sites)
n.date = length(dates)

# Get residuals by site:
resid.by.site = matrix(NA,n.date,n.site)
colnames(resid.by.site) = sites
isite.used = match(site.df$name,sites)
itime.used = match(site.df$yyyymmddhhmm,dates)
resid.by.site[cbind(itime.used,isite.used)] = site.df$resid

# Delete empty rows and columns:
all.na.site = rep.int(F,n.site)
for (i.site in 1:n.site) all.na.site[i.site] =  all(is.na(resid.by.site[,i.site]))
all.na.date = rep.int(F,n.date)
for (i.date in 1:n.date) all.na.date[i.date] = all(is.na(resid.by.site[i.date,]))
resid.by.site = as.matrix(resid.by.site[!all.na.date,][,!all.na.site])
n.site = ncol(resid.by.site)
n.date = nrow(resid.by.site)

if (do.pdf) pdf(file=file.pdf,title=paste('written_by',ri$prog))

index.in.all.sta = match(colnames(resid.by.site),dimnames(site.data)[[3]])
scale.lon = cos(pi/180*mean(site.data[1,"lat",index.in.all.sta ]))

opar = par(no.readonly=T)
par(xpd=NA)
darkaqua6 = add.alpha(gplots::col2hex("aquamarine4"),0.6)

sta.res.cor = cor(resid.by.site, use="pairwise")
sta.res.cov =  cov(resid.by.site, use="pairwise")

min.cor = 0.55
min.cov = 25

for (mapreg in map.regions) {

  # get coords
  coord.file = str_c('~esswein/science/region/boundary/',region)
  if (mapreg == '') coord.file = str_c(coord.file,'.coords') else coord.file = str_c(coord.file,'.',mapreg,'.coords')
  coords = read.table(coord.file,header=T)
## NOTE: scale lon for spatial correctness.
  xlim = scale.lon*range(coords$lon)
  ylim = range(coords$lat)
plot(scale.lon*site.data[1,"lon",index.in.all.sta ],site.data[1,"lat",index.in.all.sta ],asp=1,xlim=xlim,ylim=ylim,xlab='',ylab='',xaxt='n',yaxt='n')
text( (scale.lon*site.data[1,"lon",index.in.all.sta]), ( site.data[1,"lat",index.in.all.sta] ),
  labels = colnames(resid.by.site), pos=2, offset=1, cex=0.7, col=darkaqua6,font=4)

  for ( first.sta  in 2:(n.site) )   {
    end.sta = first.sta - 1
    for ( second.sta in 1:(end.sta) )   {
      if (is.na(sta.res.cor[first.sta, second.sta])) next
      if (sta.res.cor[first.sta, second.sta] > min.cor ) {
        lines( c(scale.lon*site.data[1,"lon",index.in.all.sta[first.sta ]], scale.lon*site.data[1,"lon",index.in.all.sta[second.sta ]]) ,
          c( site.data[1,"lat",index.in.all.sta[first.sta ]], site.data[1,"lat",index.in.all.sta[second.sta ]]) ,
          lwd= (sta.res.cor[first.sta,second.sta]/0.3 ) )

        text( x= 0.5*(scale.lon*site.data[1,"lon",index.in.all.sta[first.sta ]] +  scale.lon*site.data[1,"lon",index.in.all.sta[second.sta ]]) ,
          y = 0.5*( site.data[1,"lat",index.in.all.sta[first.sta ]] + site.data[1,"lat",index.in.all.sta[second.sta ]]),
          labels=format(sta.res.cor[first.sta, second.sta],digits=2) , pos=4, offset = 1, cex=2.25*(sta.res.cor[first.sta, second.sta])^2 )
      }
    }
  }

}

toffset = -.02
site.lab = rev(sites[index.in.all.sta])
m = t(sta.res.cor)
m[upper.tri(m,diag=T)] = NA
par(plt=c(.2,.85,.25,.90))
pal = two.colors(n=64,start='blue2',middle='gray80',end='red')
image.plot(m,xaxt='n',yaxt='n',col=pal,main='Residuals correlation')
lim = par('usr')
xtick = midpoint(seq(lim[1],lim[2],len=n.site+1))
ytick = midpoint(seq(lim[3],lim[4],len=n.site+1))
points(-10,-10)
text(xtick,lim[3]+toffset,lab=site.lab,srt=90,xpd=NA,adj=1,cex=.5)
text(lim[1]+toffset,ytick,lab=site.lab,xpd=NA,adj=1,cex=.5)

m = t(sta.res.cov)
m[upper.tri(m)] = NA
par(plt=c(.2,.85,.25,.90))
pal = two.colors(n=64,start='blue2',middle='gray80',end='red')
image.plot(m,xaxt='n',yaxt='n',col=pal,main='Residuals covariance')
lim = par('usr')
xtick = midpoint(seq(lim[1],lim[2],len=n.site+1))
ytick = midpoint(seq(lim[3],lim[4],len=n.site+1))
points(-10,-10)
text(xtick,lim[3]+toffset,lab=site.lab,srt=90,xpd=NA,adj=1,cex=.5)
text(lim[1]+toffset,ytick,lab=site.lab,xpd=NA,adj=1,cex=.5)

if (do.pdf) {
  dev.off()
  cat(file.pdf,'\n')
}
par(opar)

dat.save = list(resid.by.site=resid.by.site,sta.res.cov=sta.res.cov,sta.res.cor=sta.res.cor)
attr(dat.save,'written_by') = sub('/Users/','~',ri$prog)
saveRDS(dat.save,file=file.rds)


artists <- read_csv("/repository-demo/artist_data.csv")
born <- artists$yearOfBirth
df <- data.frame(born)

ggplot(df, mapping=aes(x = born, y = as.numeric(row.names(df)))) +
           geom_point(size=2.2, alpha=0.4, shape=15) +
           labs(x = "Year", y=element_blank(),
                title = "Distribution of Artist's Birth Years at the Tate",
                subtitle = "From the Museum's Permanent Collection") +
           theme_bw() +
           theme(axis.text.y = element_blank(),
                 axis.ticks.y = element_blank(),
                 panel.grid.minor=element_blank(),
                 panel.grid.major.y=element_blank())


### number of walks between stripes
#compute walks for each individum
walks = c()
for (i in c(1:nrow(id_table))) {
  walks = c(walks,nrow(c.nwalks(traj[id(traj)==id_table$id[i]],env[[i]])))
}
walks=walks/f_table$length_experiment

f_table = data.frame(f_table,number_of_walks_permin=walks)

f_table_positive= data.frame(f_table_positive,number_of_walks_permin=walks)

# takes g_inputdir,g_filetable and g_outputdir
# takes g_bin_size
# return angle deviation = stripe deviation plots (mean of median, histogram /not the individuals)

### compute angle deviation

#plot_title = "Stripe Deviation Histogram (Groups)"
#plot_title2 = "Stripe Deviation Histogram (Individuals)"

angle_table = data.frame()

#compute angle deviations for each individum
for (i in c(1:nrow(id_table))) {

	angle = c.angle.dev(traj[id(traj)==id_table$id[i]],env[[i]])
	id = rep(id_table$id[i],nrow(angle))
	group = rep(id_table$group[i],nrow(angle))
	angle_table = rbind(angle_table,data.frame(angle,id,group))
}

# create bins
# if (g_bin_size==0)
	# g_bin_size = 0.5
# v = angle_table$dev
# bins = seq(min(v[!is.na(v)])-g_bin_size,max(v[!is.na(v)])+g_bin_size,g_bin_size)

# compute median of the deviation

median_dev = c()
for (i in c(1:nrow(id_table))) {

	dev_2 = angle_table[angle_table$id==id_table$id[i],]$dev

	median_dev = c(median_dev,median(dev_2,na.rm = TRUE))

}
angle_table_2 = data.frame(median_dev,id=id_table$id,group=id_table$group)
f_table=data.frame(f_table,stripe_deviation=median_dev)
f_table_index = data.frame(f_table_index,stripe_deviation=median_dev)
#create mean and sd table

# mean_table = create.mean.table(angle_table_2,group_ids,data_cols=1:1)

# message("starting plots mean")
# mybarplot(mean_table$means$median_dev,mean_table$ses$median_dev,rownames(mean_table$means),
	# main="mean of medians of stripe deviation",ylab="angle deviation [degrees]", ylim = c(0,ylim_angledev))
  # abline(h=45, col=2)

#create two histograms
#hplot1 = histogram(~ dev | group ,data=angle_table, breaks=bins-0.01, type="percent",col=0, include.lowest= TRUE)
##hplot2 = histogram(~ dev | id ,data=angle_table,breaks=bins, type="percent",col=0)
#hplot1 = update(hplot1,main=plot_title, ylab="Frequency", xlab="Angle deviation [degree]",layout=c(2,2))
##hplot2 = update(hplot2,main=plot_title2, ylab="Frequency", xlab="Angle deviation [degree]",layout=c(3,3))
#print(hplot1)
##print(hplot2)
#
#


# Wrapper functions for uncooperative base models

#' Trivial regression model which returns a given constant
#'
#' @param x the matrix of predictors
#' @param y the vector of responses
#' @param k the constant to return
#' @export
constant <- function (x, y, k) {
  model <- list(k=k);
  class(model) <- 'constant';
  return(model);
}

#' Trivial regression model which returns a given constant
#'
#' @param object the model object
#' @param newdata the matrix of new predictors
#' @param ... other parameters (unused)
#' @method predict constant
#' @export
predict.constant <- function(object, newdata, ...) {
  return(rep(object$k, nrow(newdata)));
}

#' Wrapper for loess fit
#'
#' @param x the matrix of predictors
#' @param y the vector of responses
#' @param ... other parameters to pass to \code{loess()}
#' @export
loess.fit <- function(x, y, ...) {
  model <- loess(y ~ x, ...);
}


#' Plot ecological network organized by trophic level, with node size determined by the node degree, and modules.
#'
#' @param ig igraph object
#' @param vertexLabel logical plot vertex labels
#' @param vertexSizeFactor numeric factor to determine the size of the label with degree
#' @param vertexSizeMin    numeric determine the minimum size of the label
#' @param tk TRUE generate an interactive plot using tkplot and returns a matrix with coordinates from [igraph::tkplot.getcoords()]
#' @param lMat Matrix of postions for the nodes
#' @param modules if TRUE plot modules in the x axis, obtained with the cluster spinglass algorithm
#' @param weights The weights of the edges for the [igraph::cluster_spinglass()] community detection, either a numeric vector, NULL, or NA.
#'                if NULL and the network has a 'weight' attribute then that will be used,
#'                if NA then the 'weight' attributte is not considered.
#' @param community_obj Insteado of calculating modules/communities with cluster spinglass take a community object
#' @param bpal if NULL it uses the "RdYlGn" RColorBrewer palette, else must be a vector of colors of length 11.
#' @param maxTL maximum trophic level to draw y-axis
#'
#' @param ... Addittional parameters to the plot function
#'
#' @return returns a plot and if tk==TRUE returns a layout matrix
#' @export
#'
#' @aliases plotTrophLevel
#'
#'
#' @importFrom NetIndices TrophInd
#' @importFrom igraph     V degree get.adjacency cluster_spinglass vcount
#' @importFrom RColorBrewer brewer.pal
#' @importFrom dplyr      "%>%" mutate dense_rank
#' @examples
#'
#' plot_troph_level(netData[[1]])
plot_troph_level <- function(g,vertexLabel=FALSE,vertexSizeFactor=5,vertexSizeMin=5,tk=FALSE,modules=FALSE,lMat=NULL,weights=NA,community_obj=NULL, bpal= NULL,
                             maxTL=NULL,...){

  deg <- degree(g, mode="all") # calculate the degree: the number of edges
  # or interactions

  V(g)$size <- log10(deg)*vertexSizeFactor+vertexSizeMin    # add node degrees to igraph object

  V(g)$frame.color <- "white"    # Specify plot options directly on the object

  V(g)$color <- "orange"         #
  E(g)$color <- "gray50"
  #E(g)$width <- .3
  # if( !is.null(edge.width )) {
  #   if( is.null(weights) )
  #       E(g)$width <- E(g)$width* edge.width
  #   else if( is.vector(weights, mode="numeric"))
  #       E(g)$width <- weights* edge.width
  # }

  if(!vertexLabel)
    V(g)$label <- NA

  if(inherits(g, "mgraph") && ("Trophic" %in% unique(unlist(edge.attributes(g)))) ){
    tt <- subgraph.edges(g,E(g)[E(g)$type=="Trophic"])
    tl <- TrophInd(get.adjacency(tt,sparse=F))
  } else {
    tl <- TrophInd(get.adjacency(g,sparse=F))  # Calculate the trophic level
  }
  # Layout matrix to specify the position of each vertix
  # Rows equal to the number of vertices (species)
  if(is.null(lMat)){

    lMat <-matrix(
      nrow=vcount(g),
      ncol=2
    )

    lMat[,2]<-jitter(tl$TL,0.1)              # y-axis value based on trophic level

    if(modules) {
      if(!is.null(community_obj)) {
        m <- community_obj
      } else {
        if(count_components(g)>1){
          if(!is.named(g)) V(g)$name <- (1:vcount(g))
          dg <- components(g)
          V(g)$membership = 0
          for(comp in unique(dg$membership)) {
            g1 <- induced_subgraph(g, which(dg$membership == comp))
            m<-cluster_spinglass(g1,weights=weights)
            if(length(m$membership)==0)
              m$membership <- 1
            V(g)[V(g1)$name]$membership <-  m$membership + max(V(g)$membership)
          }
          m$membership <- V(g)$membership

        } else {
          m<-cluster_spinglass(g,weights=weights)
        }
      }
      # Order groups in ascending trofic level
      #
      df <- data.frame(tl=tl$TL,m=m$membership)
      df <- df %>% mutate(m = dense_rank(ave(tl, m, FUN = max)))
      lMat[,1]<-jitter(df$m,1) # randomly assign along x-axis

    } else {
      lMat[,1]<-runif(vcount(g))               # randomly assign along x-axis
    }
  }

  colTL <-as.numeric(cut(tl$TL,11))   # Divide trophic levels in 11 segments
  if( !is.null(bpal)) {
    colnet <- colorRampPalette(bpal)(11)
  } else {
    colnet <- brewer.pal(11,"RdYlGn")   # Assign colors to trophic levels
  }
  V(g)$color <- colnet[12-colTL]      # Add colors to the igraph object

  if(tk){
    tkid <- tkplot(g, edge.arrow.size=.4,
       edge.curved=0.3, layout=lMat,...)
    return( tkplot.getcoords(tkid))

  } else {
    plot(g, edge.arrow.size=.4,
         edge.curved=0.3, layout=lMat,...)
    maxnew <- max(tl$TL)
    minnew <- min(tl$TL)
    maxold <- 1
    minold <- -1
    t2 <- function(x) (maxold-minold)/(maxnew -minnew)*(x - maxnew)+maxold
    tlseq <- seq(1,ifelse(is.null(maxTL),maxnew+1,maxTL),by=1)
    axis(side=2,at=t2(tlseq),labels=tlseq,  las=1, col = NA, col.ticks = 1)

  }

}

#' @export
#'
plotTrophLevel <- function(g,vertexLabel=FALSE,vertexSizeFactor=5,vertexSizeMin=5,tk=FALSE,modules=FALSE,lMat=NULL,weights=NA,community_obj=NULL, bpal= NULL,
                           maxTL=NULL,...)
  {
  plot_troph_level(g,vertexLabel,vertexSizeFactor,vertexSizeMin,tk,modules,lMat,weights, community_obj,bpal,maxTL, ...)
}


rm(list=ls())
load("HDIdata.rda")

y=array(NA,c(164,6,3))
nams=HDIdata[1:164,2]

u=unique(HDIdata[,1])
for(j in 1:6) {
for(h in 1:3) {
y[,j,h]=HDIdata[HDIdata[,1]==u[j],h+2]}}

source("codeKvariable.r")

x=c(0,0.05,0.1,0.15,0.2,0.25,0.3,0.35,0.4,0.45,0.5)

library(snipEM)
library(mvtnorm)
set.seed(12345)

rl=list()

# pre-training for good inits
inits0=rlm.fixed(y,c(4,4,4,3,3,3))
inits0$k=rep(4,6)
pt=rlm.fixed(y,c(2,3,2,2,4,2))
inits0$pi[2,]=pt$pi[2,]
inits0$PI[2,2,,]=pt$PI[2,2,,]
inits0$PI[3,2,,]=pt$PI[3,2,,]
inits0$PI[2,3,,]=pt$PI[2,3,,]
inits0$PI[2,4,,]=pt$PI[2,4,,]
inits0$PI[4,2,,]=pt$PI[4,2,,]
inits0$xi[2,,]=pt$xi[2,,]
inits0$sigma[2,,]=pt$sigma[2,,]
pt=rlm.fixed(y,c(3,4,3,4,3,4))
inits0$pi[3,]=pt$pi[3,]
inits0$PI[3,4,,]=pt$PI[3,4,,]

rl[[1]]=rlm(y,0,4,inits=inits0)

for(whl in 2:length(x)) {
    inits=rl[[whl-1]]
    inits$k=rep(3,6)
    rl[[whl]]=rlm(y,x[whl],4,inits=inits,hits=50)
}

liks=sapply(1:length(x),function(j) rl[[j]]$lik)
crit=diff(liks)/(mean(liks)*diff(x))

save.image(file="rl.rda")


test_that("works with smaller matrix",{
  fmax_info <- maximize_wrench(H_matrix_mini, bounds_tuple_of_numeric_mini, direction = c(1.0))
  expect_equal(fmax_info$muscle_activation_pattern_per_task[[1]],c(1,0,1))
  expect_equal(fmax_info$output_vector_per_task[[1]],5.333333333, 1e-5)
  })

test_that("f",{
  fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
  })


rm(list=ls(all=TRUE))
Sys.setlocale(locale="chinese")
setwd('./data')
#library(geojsonio)
#library(ropencc)
library(dplyr)
#library(jsonlite)
library(leaflet)
library(geojson)
library(sp)
library(sf)
library(rgeos)
library(rgdal)
#library(stringdist)
library(data.table)
#library(fasttime)
#library(tidyr)
library(raster)

jsonfile <- "boundary.geojson"

boundary <- readOGR(jsonfile,  require_geomType="wkbPolygon",use_iconv = TRUE, encoding = "UTF-8")

boundary <- boundary[boundary@data$name=="珠海市" & !is.na(boundary@data$name) ,]

zh_mainland=boundary@polygons[[1]]@Polygons[[15]]

zh_mainland <- SpatialPolygons(list(Polygons(list(zh_mainland),ID=1)),
                proj4string= CRS("+proj=longlat +ellps=WGS84")
)

e <- extent(bbox(zh_mainland))                  # define boundaries of object
r <- raster(e)                           # create raster object
dim(r) <- c(80, 80)                      # specify number of cells
projection(r) <- CRS(proj4string(zh_mainland))  # give it the same projection as port
g <- as(r, 'SpatialPolygonsDataFrame')

p <- g[zh_mainland,]

map <- gIntersection(p,zh_mainland,byid = TRUE,drop_lower_td = TRUE)

map <-SpatialPolygonsDataFrame(map,data.frame(UID=seq(1,length(map))),match.ID = FALSE)

#leaflet(boundary@polygons[[1]]@Polygons[[15]]) %>%
#addPolygons(stroke = TRUE,opacity = 1,fillOpacity = 0.5, smoothFactor = 0.5,
#                                           color="black") %>%
#  addTiles()

#plot(map)

leaflet(map) %>%
addPolygons(stroke = TRUE,opacity = 1,fillOpacity = 0.4, smoothFactor = 0.5,
            color="black",weight = 0.2) %>%
  addTiles()

setwd('../analytical_grids')
writeOGR(obj=map, dsn="grids", layer="grids", driver="ESRI Shapefile")
setwd('../data')


###
# Figure 2
###
# depends on TP-FP-yeast.setup, TP-FP-ty.setup, FP-only-summary-parallel.r

pdf('FP-plots.pdf', height=4.5, width=12)
par(mfrow=c(1,3))

plot(med.data.FP.yeast[,1], (med.data.FP.yeast[,3])/nrow(d.good),  col='grey30',
  ylim=c(1e-4,0.6), log='y', type='b', xlab='N samples', ylab='False positive proportion', main='A')
points(med.data.FP.yeast[,1], (med.data.FP.yeast[,2])/nrow(d.good), col='grey70', type='b')
points(med.data.FP.yeast[,1], (med.data.FP.yeast[,4])/nrow(d.good), col='black', type='b')
points(med.data.FP.yeast[,1], (med.data.FP.yeast[,5])/nrow(d.good), col='brown', type='b')
points(med.data.FP.yeast[,1], (med.data.FP.yeast[,6])/nrow(d.good), col='cornflowerblue', type='b')
points(med.data.FP.yeast[,1], (med.data.FP.yeast[,7])/nrow(d.good), col='orange', type='b')
#points(med.data.FP.yeast[,1], (upper.data.FP.yeast[,7])/nrow(d.good), col='orange', type='b', pch=19)

points(med.data.FP.ty[,1], (med.data.FP.ty[,2])/nrow(d), pch=0, col='grey70', type='b')
points(med.data.FP.ty[,1], (med.data.FP.ty[,3])/nrow(d), pch=0,col='grey30', type='b')
points(med.data.FP.ty[,1], (med.data.FP.ty[,4])/nrow(d),pch=0, col='black', type='b')
points(med.data.FP.ty[,1], (med.data.FP.ty[,5])/nrow(d),pch=0, col='brown', type='b')
points(med.data.FP.ty[,1], (med.data.FP.ty[,6])/nrow(d),pch=0, col='cornflowerblue', type='b')
points(med.data.FP.ty[,1], (med.data.FP.ty[,7])/nrow(d),pch=0, col='orange', type='b')
#points(med.data.FP.ty[,1], (upper.data.FP.ty[,7])/nrow(d),pch=17, col='orange', type='b')

legend(15, 3.5e-4, legend=c('yeast', '16S'), col=c('grey','grey'), pch=c(1,0) )

legend(10, 1.5e-3, legend=c('diff >1', 'E > 0.5', 'E >1', 'E >2', 'ol <0.1', 'triple' ), col=c('cornflowerblue', 'grey70', 'grey30','black', 'brown', 'orange'), pch=15 )

plot(x.e$diff.win, x.e$diff.btw, pch=19, col=rgb(0,0,0,0.1), xlab="Dispersion", ylab='Difference', main='B')
points(x.e[setdiff(test.diff, yeast.diff),'diff.win'], x.e[setdiff(test.diff, yeast.diff),'diff.btw'], pch=19, col=rgb(0,0.7,1,0.4))
points(x.e[setdiff(test.eff, yeast.eff),'diff.win'], x.e[setdiff(test.eff, yeast.eff),'diff.btw'], pch=19, col=rgb(1,0.6,0,0.4))
legend(2, 7,legend=c('FP difference',"FP effect", 'not FP'),pch=19, col=c(rgb(0,0.6,0.9,1), rgb(.9,0.55,0,1), rgb(0,0,0,0.3)))

plot(t.e$diff.win, t.e$diff.btw, pch=19, col=rgb(0,0,0,0.1), xlab='Dispersion', ylab='Difference', main='C')
points(t.e[setdiff(test.ty.diff, ty.diff),'diff.win'], t.e[setdiff(test.ty.diff, ty.diff),'diff.btw'], pch=19, col=rgb(0,0.7,1,0.4))
points(t.e[setdiff(test.ty.eff, ty.eff),'diff.win'], t.e[setdiff(test.ty.eff, ty.eff),'diff.btw'], pch=19, col=rgb(1,0.6,0,0.4))

dev.off()


  get.cohort.data = function(ageclass, yrs, cats, varmap, M, outvar="total") {

    yrs = as.numeric(yrs)
    n.age = length( ageclass )
    n.yrs = length( yrs )

    YRS = c( (max(yrs) - (2*length(yrs))+1 ): max(yrs) )
    n.YRS = length( YRS )
    n.cats = length( cats )

  #  ageclass.indices =  c( 1:n.age )

    Q = array( data=0, dim=c(n.age, n.cats, n.YRS), dimnames=list(ageclass, cats, YRS) )

    for ( iyc in n.age:1) {
      for ( jyc in iyc:n.age ) {
        ac = ageclass[jyc]

        for ( iyr in 1:n.yrs ) {  # the year class (starting with yc5)
          yr = yrs[iyr]
          yr2 = yr - jyc + 1

          Q[ac,, as.character(yr2)] = M[ac,, as.character(yr) ]
        }
      }
   }

  return (Q)
  }


./tests.verify: test performed on 2006.01.24

#### Test: ./tests.verify running simviz1c.py --m 10 --func siny --screenplot 0
CPU time of simviz1c.py: 0.1 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running simviz1cp.py --m 10 --func siny --screenplot 0
tstop= 40
CPU time of simviz1cp.py: 0.4 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running simviz1cp_unit.py -m "10 kg" -func siny --screenplot 0
CPU time of simviz1cp_unit.py: 0.4 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running tmp.sh
Content-type: text/html

<FORM ACTION="wrapper.sh.cgi?s=simviz1cpCGI.py.cgi" METHOD="POST">

m	<INPUT TYPE="text" NAME="m" SIZE=15 VALUE="1.0">	(mass)

b	<INPUT TYPE="text" NAME="b" SIZE=15 VALUE="0.7">	(damping)

c	<INPUT TYPE="text" NAME="c" SIZE=15 VALUE="5.0">	(stiffness)

func	<SELECT NAME="func" SIZE=1 VALUE="y">
<OPTION VALUE="y">y </OPTION>
<OPTION VALUE="y3">y3 </OPTION>
<OPTION VALUE="siny">siny </OPTION>
</SELECT>

	(spring model function)

A	<INPUT TYPE="text" NAME="A" SIZE=15 VALUE="5.0">	(forced amplitude)

w	<INPUT TYPE="text" NAME="w" SIZE=15 VALUE="6.28318530718">	(forced frequency)

y0	<INPUT TYPE="text" NAME="y0" SIZE=15 VALUE="0.2">	(initial displacement)

tstop	<INPUT TYPE="text" NAME="tstop" SIZE=15 VALUE="30.0">	(stop time)

dt	<INPUT TYPE="text" NAME="dt" SIZE=15 VALUE="0.05">	(time step)

case	<INPUT TYPE="text" NAME="case" SIZE=15 VALUE="tmp1">	(case name)

screenplot	<INPUT TYPE="checkbox" NAME="screenplot" VALUE="1">

	(plot on the screen?)

<INPUT TYPE="submit" VALUE="simulate and visualize" NAME="sim">
</FORM>

Content-type: text/html

<FORM ACTION="wrapper.sh.cgi?s=simviz1cpCGI.py.cgi" METHOD="POST">

m	<INPUT TYPE="text" NAME="m" SIZE=15 VALUE="1.0">	(mass)

b	<INPUT TYPE="text" NAME="b" SIZE=15 VALUE="0.7">	(damping)

c	<INPUT TYPE="text" NAME="c" SIZE=15 VALUE="5.0">	(stiffness)

func	<SELECT NAME="func" SIZE=1 VALUE="y">
<OPTION VALUE="y">y </OPTION>
<OPTION VALUE="y3">y3 </OPTION>
<OPTION VALUE="siny">siny </OPTION>
</SELECT>

	(spring model function)

A	<INPUT TYPE="text" NAME="A" SIZE=15 VALUE="5.0">	(forced amplitude)

w	<INPUT TYPE="text" NAME="w" SIZE=15 VALUE="6.28318530718">	(forced frequency)

y0	<INPUT TYPE="text" NAME="y0" SIZE=15 VALUE="0.2">	(initial displacement)

tstop	<INPUT TYPE="text" NAME="tstop" SIZE=15 VALUE="30.0">	(stop time)

dt	<INPUT TYPE="text" NAME="dt" SIZE=15 VALUE="0.05">	(time step)

case	<INPUT TYPE="text" NAME="case" SIZE=15 VALUE="tmp1">	(case name)

screenplot	<INPUT TYPE="checkbox" NAME="screenplot" VALUE="1">

	(plot on the screen?)

<INPUT TYPE="submit" VALUE="simulate and visualize" NAME="sim">
</FORM>

CPU time of tmp.sh: 0.9 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running tmp.sh
Content-type: text/html

<FORM ACTION="wrapper.sh.cgi?s=simviz1cpCGI_unit.py.cgi" METHOD="POST">

m	<INPUT TYPE="text" NAME="m" SIZE=15 VALUE="1.0">	kg	(mass)

b	<INPUT TYPE="text" NAME="b" SIZE=15 VALUE="0.7">	kg/s	(damping)

c	<INPUT TYPE="text" NAME="c" SIZE=15 VALUE="5.0">	kg/s**2	(stiffness)

func	<SELECT NAME="func" SIZE=1 VALUE="y">
<OPTION VALUE="y">y </OPTION>
</SELECT>

		(spring model function)

A	<INPUT TYPE="text" NAME="A" SIZE=15 VALUE="5.0">	N	(forced amplitude)

w	<INPUT TYPE="text" NAME="w" SIZE=15 VALUE="6.28318530718">	1/s	(forced frequency)

y0	<INPUT TYPE="text" NAME="y0" SIZE=15 VALUE="0.2">	m	(initial displacement)

tstop	<INPUT TYPE="text" NAME="tstop" SIZE=15 VALUE="30.0">	s	(stop time)

dt	<INPUT TYPE="text" NAME="dt" SIZE=15 VALUE="0.05">	s	(time step)

case	<INPUT TYPE="text" NAME="case" SIZE=15 VALUE="tmp1">		(case name)

screenplot	<INPUT TYPE="checkbox" NAME="screenplot" VALUE="1">

		(plot on the screen?)

<INPUT TYPE="submit" VALUE="simulate and visualize" NAME="sim">
</FORM>

Content-type: text/html

<FORM ACTION="wrapper.sh.cgi?s=simviz1cpCGI_unit.py.cgi" METHOD="POST">

m	<INPUT TYPE="text" NAME="m" SIZE=15 VALUE="1.0">	kg	(mass)

b	<INPUT TYPE="text" NAME="b" SIZE=15 VALUE="0.7">	kg/s	(damping)

c	<INPUT TYPE="text" NAME="c" SIZE=15 VALUE="5.0">	kg/s**2	(stiffness)

func	<SELECT NAME="func" SIZE=1 VALUE="y">
<OPTION VALUE="y">y </OPTION>
</SELECT>

		(spring model function)

A	<INPUT TYPE="text" NAME="A" SIZE=15 VALUE="5.0">	N	(forced amplitude)

w	<INPUT TYPE="text" NAME="w" SIZE=15 VALUE="6.28318530718">	1/s	(forced frequency)

y0	<INPUT TYPE="text" NAME="y0" SIZE=15 VALUE="0.2">	m	(initial displacement)

tstop	<INPUT TYPE="text" NAME="tstop" SIZE=15 VALUE="30.0">	s	(stop time)

dt	<INPUT TYPE="text" NAME="dt" SIZE=15 VALUE="0.05">	s	(time step)

case	<INPUT TYPE="text" NAME="case" SIZE=15 VALUE="tmp1">		(case name)

screenplot	<INPUT TYPE="checkbox" NAME="screenplot" VALUE="1">

		(plot on the screen?)

<INPUT TYPE="submit" VALUE="simulate and visualize" NAME="sim">
</FORM>

CPU time of tmp.sh: 0.9 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running mloop4simviz1.py -m '10 & 1 & 2' -c ' 0.5 & [1:6,1] & 10.1' -noscreenplot
[5, 0.5, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 1, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 2, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 3, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 4, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 5, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 6, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 10.1, 0.69999999999999996, 'y', 10, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 0.5, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 1, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 2, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 3, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 4, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 5, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 6, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 10.1, 0.69999999999999996, 'y', 1, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 0.5, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 1, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 2, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 3, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 4, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 5, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 6, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
[5, 10.1, 0.69999999999999996, 'y', 2, 6.2831853071795862, 30, 0.20000000000000001, 0.050000000000000003]
-A 5 -c 0.5 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 1 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 2 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 3 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 4 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 5 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 6 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 10.1 -b 0.69999999999999996 -func 'y' -m 10 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 0.5 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 1 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 2 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 3 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 4 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 5 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 6 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 10.1 -b 0.69999999999999996 -func 'y' -m 1 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 0.5 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 1 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 2 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 3 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 4 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 5 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 6 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
-A 5 -c 10.1 -b 0.69999999999999996 -func 'y' -m 2 -w 6.2831853071795862 -tstop 30 -y0 0.20000000000000001 -dt 0.050000000000000003
[0.5, 10] 0.1024
[1, 10] 0.1251
[2, 10] 0.1029
[3, 10] 0.1098
[4, 10] 0.1201
[5, 10] 0.1282
[6, 10] 0.1293
[10.1, 10] 0.1223
[0.5, 1] 0.1285
[1, 1] 0.1299
[2, 1] 0.1335
[3, 1] 0.1371
[4, 1] 0.1418
[5, 1] 0.1452
[6, 1] 0.1504
[10.1, 1] 0.1706
[0.5, 2] 0.0683
[1, 2] 0.0785
[2, 2] 0.0759
[3, 2] 0.0842
[4, 2] 0.0792
[5, 2] 0.0833
[6, 2] 0.0775
[10.1, 2] 0.0861
CPU time of mloop4simviz1.py: 3.4 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running mloop4simviz1_v2.py -m '10 & 1 & 2' -c ' 0.5 & [1:6,1] & 10.1' -noscreenplot
[0.5, 10] 0.1024
[1, 10] 0.1251
[2, 10] 0.1029
[3, 10] 0.1098
[4, 10] 0.1201
[5, 10] 0.1282
[6, 10] 0.1293
[10.1, 10] 0.1223
[0.5, 1] 0.1285
[1, 1] 0.1299
[2, 1] 0.1335
[3, 1] 0.1371
[4, 1] 0.1418
[5, 1] 0.1452
[6, 1] 0.1504
[10.1, 1] 0.1706
[0.5, 2] 0.0683
[1, 2] 0.0785
[2, 2] 0.0759
[3, 2] 0.0842
[4, 2] 0.0792
[5, 2] 0.0833
[6, 2] 0.0775
[10.1, 2] 0.0861
CPU time of mloop4simviz1_v2.py: 3.4 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running mloop4simviz1_v3.py -m '10 & 1 & 2' -c ' 0.5 & [1:6,1] & 10.1' -noscreenplot -remove 'm == 10 and c == 2'
replace "A" by "5"
replace "c" by "0.5"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "1"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "2"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "3"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "4"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "5"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "6"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "10.1"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "10"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "0.5"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "1"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "2"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "3"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "4"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "5"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "6"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "10.1"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "1"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "0.5"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "1"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "2"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "3"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "4"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "5"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "6"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
replace "A" by "5"
replace "c" by "10.1"
replace "b" by "0.69999999999999996"
replace "func" by "'y'"
replace "m" by "2"
replace "w" by "6.2831853071795862"
replace "tstop" by "30"
replace "y0" by "0.20000000000000001"
replace "dt" by "0.050000000000000003"
1 experiments removed
[0.5, 10] 0.1024
[1, 10] 0.1251
[3, 10] 0.1098
[4, 10] 0.1201
[5, 10] 0.1282
[6, 10] 0.1293
[10.1, 10] 0.1223
[0.5, 1] 0.1285
[1, 1] 0.1299
[2, 1] 0.1335
[3, 1] 0.1371
[4, 1] 0.1418
[5, 1] 0.1452
[6, 1] 0.1504
[10.1, 1] 0.1706
[0.5, 2] 0.0683
[1, 2] 0.0785
[2, 2] 0.0759
[3, 2] 0.0842
[4, 2] 0.0792
[5, 2] 0.0833
[6, 2] 0.0775
[10.1, 2] 0.0861
CPU time of mloop4simviz1_v3.py: 3.3 seconds on ubuntu i686, Linux

#### Test: ./tests.verify running inputfile_wunits.py _test
parsed_lines:
[{'comment': '',
  'parameter': 'gridfile',
  'ref_unit': None,
  'unit': None,
  'value': 'somefile.grid'},
 {'comment': '',
  'parameter': 'add boundary indicator nodes',
  'ref_unit': None,
  'unit': None,
  'value': 'n=1 b4=[0,1]x[-2,-2]'},
 {'comment': '! [s]',
  'parameter': 'time step',
  'ref_unit': 's',
  'unit': 'h',
  'value': 1800.0},
 {'comment': '! [K/m]',
  'parameter': 'heat heatflux 1',
  'ref_unit': 'K/m',
  'unit': 'K/m',
  'value': 0.01},
 {'comment': '! [K/m]',
  'parameter': 'heat heatflux 2',
  'ref_unit': 'K/m',
  'unit': 'K/m',
  'value': 0.02},
 {'comment': '',
  'parameter': 'time points for plot',
  'ref_unit': None,
  'unit': None,
  'value': [0, 1.5, 3, 10, 100]},
 'sub heat LinEqAdmFE  ! submenu\n',
 'sub heat Matrix_prm\n',
 {'comment': '',
  'parameter': 'heat matrix type',
  'ref_unit': None,
  'unit': None,
  'value': 'MatSparse'},
 {'comment': '',
  'parameter': 'max no of iterations',
  'ref_unit': None,
  'unit': None,
  'value': 120},
 'ok  ! return back to previous level\n',
 'ok\n',
 'ok\n']
output_lines:
['set gridfile = somefile.grid \n',
 'set add boundary indicator nodes = n=1 b4=[0,1]x[-2,-2] \n',
 'set time step = 1800.0 ! [s]\n',
 'set heat heatflux 1 = 0.01 ! [K/m]\n',
 'set heat heatflux 2 = 0.02 ! [K/m]\n',
 'set time points for plot = [0, 1.5, 3, 10, 100] \n',
 'sub heat LinEqAdmFE  ! submenu\n',
 'sub heat Matrix_prm\n',
 'set heat matrix type = MatSparse \n',
 'set max no of iterations = 120 \n',
 'ok  ! return back to previous level\n',
 'ok\n',
 'ok\n']

new input file:
set gridfile = my.grid
set add boundary indicator nodes = n=1 b4=[0,1]x[-2,-2]
set time step = 1800.0 ! [s]
set heat heatflux 1 = 1 K/cm ! [K/m]
set heat heatflux 2 = 4.5 K/cm ! [K/m]
set time points for plot = [0, 1.5, 3, 10, 100]
sub heat LinEqAdmFE  ! submenu
sub heat Matrix_prm
set heat matrix type = MatSparse
set max no of iterations = 30
ok  ! return back to previous level
ok
ok

CPU time of inputfile_wunits.py: 0.4 seconds on ubuntu i686, Linux


## 3. The if statement ##

library(tidyverse)
recent_grads <- read_csv("recent_grads.csv")
if (nrow(recent_grads) > 1000) {
  data_size <- "Large"
} else {
  data_size <- "Small"
}

## 4. The if_else() Function ##

library(tidyverse)
recent_grads <- read_csv("recent_grads.csv")
new_recent_grads <- recent_grads %>%
  mutate(
    median_level = if_else(Median > 50000, "Above Average", "Below Average"),
    greater_prop_gender = if_else(Women > Men, "Women", "Men")
  )

## 5. Moving Beyond Two Branches ##

wpm <- 70
if (wpm < 68) {
  classfication <- "Below Average"
} else if (wpm > 82) {
  classfication <- "Above Average"
} else {
  classification <- "Average"
}

## 6. Using Multiple Conditions ##

wpm <- 70
if (wpm >= 68 && wpm <= 82) {
  classfication <- "Average"
} else {
  classification <- "Not Average"
}

## 8. The case_when() Function ##

library(tidyverse)
recent_grads <- read_csv("recent_grads.csv")
new_recent_grads <- recent_grads %>%
  mutate(
    unemployment_level = case_when(
      Unemployment_rate < 0.2 ~ "<20%",
      Unemployment_rate >= 0.2 && Unemployment_rate < 0.4 ~ "20% to 40%",
      Unemployment_rate >= 0.4 && Unemployment_rate < 0.6 ~ "40% to 60%",
      Unemployment_rate >= 0.6 && Unemployment_rate < 0.8 ~ "60% to 80%",
      Unemployment_rate >= 0.8 ~ ">=80%"
    )
  )

## 9. Other Useful Comparison Operators ##

library(tidyverse)
recent_grads <- read_csv("recent_grads.csv")
arts_grads <- recent_grads %>%
  filter(
    Major_category %in% c("Arts", "Humanities and Liberal Arts")
  )

non_engineering_science_grads <- recent_grads %>%
  filter(
    !(Major_category %in% c("Engineering", "Physical Sciences"))
  )

Data Analyst in R/Step 1 - Introduction to R/3. Control Flow, Iteration and Functions in R/1. Control Flow in R.r


x<-c()
  lines<-readLines("/Users/kennyhelsens/tmp/sigpep/AQQNHLASTNR.tsv")
	for (i in seq(length(lines))) {
		line<-lines[i]
		line.split<-strsplit(line, "\t")
		x[i]<-line.split
	}

# Calculate the max value for the x-axis
target<-x[[2]]
target<-as.double(target[3:length(target)])
x.max<-max(target)
x.max

plot(0,0,type="n", xlim=c(0,x.max), ylim=c(0,length(x)))
#plot(0,0,type="n", xlim=c(0,x.max), ylim=c(0,50))

# Plot background ions.
for (i in (3:length(x))) {
	for (j in (3:length(x[[i]]))) {
		line<-x[[i]]
		value<-as.double(line[j])
		points(x=value, y=i, col="green", cex=0.1, pch=20)
	}
}

# Second plot target ions.
for (i in (3:length(x[[2]]))) {
  line<-x[[2]]
	value<-as.double(line[i])
	points(x=value, y=2, col="red", cex=1, pch=18)
}

 # First plot barcode.
for (i in (3:length(x[[1]]))) {
  line<-x[[1]]
	value<-as.double(line[i])
	abline(v=value, col="red")
}


#!/usr/bin/env Rscript

################################################
################################################
## REQUIREMENTS                               ##
################################################
################################################

## PCA, HEATMAP AND SCATTERPLOTS FOR SAMPLES IN COUNTS FILE
    ## - SAMPLE NAMES HAVE TO END IN e.g. "_R1" REPRESENTING REPLICATE ID. LAST 3 CHARACTERS OF SAMPLE NAME WILL BE TRIMMED TO OBTAIN GROUP ID FOR DESEQ2 COMPARISONS.
    ## - PACKAGES BELOW NEED TO BE AVAILABLE TO LOAD WHEN RUNNING R

################################################
################################################
## LOAD LIBRARIES                             ##
################################################
################################################

library(optparse)
library(DESeq2)
library(BiocParallel)
library(ggplot2)
library(RColorBrewer)
library(pheatmap)

################################################
################################################
## PARSE COMMAND-LINE PARAMETERS              ##
################################################
################################################

option_list <- list(
    make_option(c("-i", "--count_file"    ), type="character", default=NULL    , metavar="path"   , help="Count file matrix where rows are genes and columns are samples."                        ),
    make_option(c("-f", "--count_col"     ), type="integer"  , default=2       , metavar="integer", help="First column containing sample count data."                                             ),
    make_option(c("-d", "--id_col"        ), type="integer"  , default=1       , metavar="integer", help="Column containing identifiers to be used."                                              ),
    make_option(c("-r", "--sample_suffix" ), type="character", default=''      , metavar="string" , help="Suffix to remove after sample name in columns e.g. '.rmDup.bam' if 'DRUG_R1.rmDup.bam'."),
    make_option(c("-o", "--outdir"        ), type="character", default='./'    , metavar="path"   , help="Output directory."                                                                      ),
    make_option(c("-p", "--outprefix"     ), type="character", default='deseq2', metavar="string" , help="Output prefix."                                                                         ),
    make_option(c("-v", "--vst"           ), type="logical"  , default=FALSE   , metavar="boolean", help="Run vst transform instead of rlog."                                                     ),
    make_option(c("-c", "--cores"         ), type="integer"  , default=1       , metavar="integer", help="Number of cores."                                                                       )
)

opt_parser <- OptionParser(option_list=option_list)
opt        <- parse_args(opt_parser)

if (is.null(opt$count_file)){
    print_help(opt_parser)
    stop("Please provide a counts file.", call.=FALSE)
}

################################################
################################################
## READ IN COUNTS FILE                        ##
################################################
################################################

count.table           <- read.delim(file=opt$count_file,header=TRUE)
rownames(count.table) <- count.table[,opt$id_col]
count.table           <- count.table[,opt$count_col:ncol(count.table),drop=FALSE]
colnames(count.table) <- gsub(opt$sample_suffix,"",colnames(count.table))
colnames(count.table) <- gsub(pattern='\\.$', replacement='', colnames(count.table))

################################################
################################################
## RUN DESEQ2                                 ##
################################################
################################################

if (file.exists(opt$outdir) == FALSE) {
    dir.create(opt$outdir,recursive=TRUE)
}
setwd(opt$outdir)

samples.vec <- sort(colnames(count.table))
groups      <- sub("_[^_]+$", "", samples.vec)
if (length(unique(groups)) == 1 || length(unique(groups)) == length(samples.vec)) {
    quit(save = "no", status = 0, runLast = FALSE)
}

DDSFile <- paste(opt$outprefix,".dds.RData",sep="")
if (file.exists(DDSFile) == FALSE) {
    counts  <- count.table[,samples.vec,drop=FALSE]
    coldata <- data.frame(row.names=colnames(counts), condition=groups)
    dds     <- DESeqDataSetFromMatrix(countData=round(counts), colData=coldata, design=~ condition)
    dds     <- DESeq(dds, parallel=TRUE, BPPARAM=MulticoreParam(opt$cores))
    if (!opt$vst) {
        vst_name <- "rlog"
        rld      <- rlog(dds)
    } else {
        vst_name <- "vst"
        rld      <- varianceStabilizingTransformation(dds)
    }
    assay(dds, vst_name) <- assay(rld)
    save(dds,file=DDSFile)
} else {
    load(DDSFile)
    vst_name <- intersect(assayNames(dds), c("vst", "rlog"))
    if (length(vst_name)==0) { # legacy might mean vst was saved as a separate object called rld
        vst_name <- "loaded_rld"
        assay(dds, vst_name) <- assay(rld)
    } else {
        vst_name==vst_name[1]
    }
}

################################################
################################################
## PLOT QC                                    ##
################################################
################################################

##' PCA pre-processeor
##'
##' Generate all the necessary information to plot PCA from a DESeq2 object
##' in which an assay containing a variance-stabilised matrix of counts is
##' stored. Copied from DESeq2::plotPCA, but with additional ability to
##' say which assay to run the PCA on, and adds an assessment of how well
##' each PC explains the experimental grouping of the data.
##'
##' @param object The DESeq2DataSet object.
##' @param intgroup interesting groups: a character vector of names in 'colData(x)' to use for grouping.
##' @param ntop number of top genes to use for principla components, selected by highest row variance.
##' @param assay the name or index of the assay that stores the variance-stabilised data.
##' @return A data.frame containing the projected data alongside the grouping columns.
##' A 'percentVar' attribute is set which includes the percentage of variation each PC explains,
##' and additionally how much the variation within that PC is explained by the grouping variable.
##' @author Gavin Kelly
plotPCA_vst <- function (object, intgroup = "condition", ntop = 500, assay=length(assays(object))) {
    rv         <- rowVars(assay(object, assay))
    select     <- order(rv, decreasing = TRUE)[seq_len(min(ntop, length(rv)))]
    pca        <- prcomp(t(assay(object, assay)[select, ]))
    percentVar <- pca$sdev^2/sum(pca$sdev^2)
    if (!all(intgroup %in% names(colData(object)))) {
        stop("the argument 'intgroup' should specify columns of colData(dds)")
    }
    intgroup.df <- as.data.frame(colData(object)[, intgroup, drop = FALSE])
    group <- if (length(intgroup) > 1) {
        factor(apply(intgroup.df, 1, paste, collapse = ":"))
    }  else {
        colData(object)[[intgroup]]
    }
    d <- cbind(pca$x, group = group, intgroup.df, name = colnames(object))
    percentFrame <- data.frame(PC=seq(along=percentVar), percentVar=100*percentVar, groupR=0.0)
    for (ipc in seq(along=percentVar)) {
        fit1 <- lm(pca$x[,ipc]  ~ group)
        percentFrame$groupR[ipc] <- 100*summary(fit1)$r.squared
    }
    attr(d, "percentVar") <- percentFrame
    return(d)
}

PlotFile <- paste(opt$outprefix,".plots.pdf",sep="")
if (file.exists(PlotFile) == FALSE) {
    pdf(file=PlotFile,onefile=TRUE,width=7,height=7)

    ## PCA
    ntop <- c(500, Inf)
    for (n_top_var in ntop) {
        pca.data      <- plotPCA_vst(dds, assay=vst_name,intgroup=c("condition"),ntop=n_top_var)
        percentVar    <- round(attr(pca.data, "percentVar")$percentVar)
        plot_subtitle <- ifelse(n_top_var==Inf, "All genes", paste("Top", n_top_var, "genes"))
        pl <- ggplot(pca.data, aes(PC1, PC2, color=condition)) +
              geom_point(size=3) +
              xlab(paste0("PC1: ",percentVar[1],"% variance")) +
              ylab(paste0("PC2: ",percentVar[2],"% variance")) +
              labs(title = paste0("First PCs on ", vst_name, "-transformed data"), subtitle = plot_subtitle) +
              theme(legend.position="top",
                    panel.grid.major = element_blank(),
                    panel.grid.minor = element_blank(),
                    panel.background = element_blank(),
                    panel.border = element_rect(colour = "black", fill=NA, size=1))
        print(pl)

        pl <- ggplot(attr(pca.data, "percentVar"), aes(x=PC, y=percentVar)) +
              geom_line(aes(colour="explained by PC")) +
              geom_line(aes(y=groupR, colour="of PC explained by condition")) +
              scale_x_continuous(breaks=seq(along=percentVar), minor_breaks=NULL)  +
              labs(title="Diagnostics of PCs", subtitle=plot_subtitle, x="Component", y="Percentage explaned", colour="Percentage variation") +
              theme_bw() +
              theme(legend.position="top")
        print(pl)

        pc_r <- order(attr(pca.data, "percentVar")$groupR, decreasing=TRUE)
        pl <- ggplot(pca.data, aes_string(paste0("PC", pc_r[1]), paste0("PC", pc_r[2]), color="condition")) +
              geom_point(size=3) +
              xlab(paste0("PC", pc_r[1], ": ",percentVar[pc_r[1]],"% variance")) +
              ylab(paste0("PC", pc_r[2], ": ",percentVar[pc_r[2]],"% variance")) +
              labs(title = paste0("Group-Explanatory PCs of ", vst_name, "-tranformed data"), subtitle = plot_subtitle) +
              theme(legend.position="top",
                    panel.grid.major = element_blank(),
                    panel.grid.minor = element_blank(),
                    panel.background = element_blank(),
                    panel.border = element_rect(colour = "black", fill=NA, size=1))
        print(pl)
    } # at end of loop, we'll be using the user-defined ntop if any, else all genes

    ## WRITE PC1 vs PC2 VALUES TO FILE
    pca.vals           <- pca.data[,1:2]
    colnames(pca.vals) <- paste0(colnames(pca.vals), ": ", percentVar[1:2], '% variance')
    pca.vals           <- cbind(sample = rownames(pca.vals), pca.vals)
    write.table(pca.vals,file=paste(opt$outprefix,".pca.vals.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t",quote=TRUE)

    ## SAMPLE CORRELATION HEATMAP
    sampleDists      <- dist(t(assay(dds, vst_name)))
    sampleDistMatrix <- as.matrix(sampleDists)
    colors           <- colorRampPalette( rev(brewer.pal(9, "Blues")) )(255)
    pheatmap(
        sampleDistMatrix,
        clustering_distance_rows=sampleDists,
        clustering_distance_cols=sampleDists,
        col=colors,
        main=paste("Euclidean distance between", vst_name, "of samples")
    )

    ## WRITE SAMPLE DISTANCES TO FILE
    write.table(cbind(sample = rownames(sampleDistMatrix), sampleDistMatrix),file=paste(opt$outprefix,".sample.dists.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t",quote=FALSE)

    dev.off()
}

################################################
################################################
## SAVE SIZE FACTORS                          ##
################################################
################################################

SizeFactorsDir <- "size_factors/"
if (file.exists(SizeFactorsDir) == FALSE) {
    dir.create(SizeFactorsDir,recursive=TRUE)
}

NormFactorsFile <- paste(SizeFactorsDir,opt$outprefix,".size_factors.RData",sep="")
if (file.exists(NormFactorsFile) == FALSE) {
    normFactors <- sizeFactors(dds)
    save(normFactors,file=NormFactorsFile)

    for (name in names(sizeFactors(dds))) {
        sizeFactorFile <- paste(SizeFactorsDir,name,".txt",sep="")
        if (file.exists(sizeFactorFile) == FALSE) {
            write(as.numeric(sizeFactors(dds)[name]),file=sizeFactorFile)
        }
    }
}

################################################
################################################
## R SESSION INFO                             ##
################################################
################################################

RLogFile <- "R_sessionInfo.log"
if (file.exists(RLogFile) == FALSE) {
    sink(RLogFile)
    a <- sessionInfo()
    print(a)
    sink()
}

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


## Function to graph the ideologies of the 2015-16 Minnesota Legislature, and to highlight any interesting lawmakers. The variables of the function should be a list of legislator names: function(c("Daudt","Peppen","Thissen")). Calling the function with no variables will graph with no highlights.
mnlegnom <- function(highlights = NA) {
	## Load the data
	library(dplyr)
	mnnom <- read.csv("nomscores.csv") %>% arrange(coord1D)
	colnames(mnnom)[1] <- "name"

	## Process the data
	mnnom.d <- subset(mnnom, coord1D <= 0)
	mnnom.r <- subset(mnnom, coord1D >= 0)

	# If you have entered highlights, checks to make sure they're in the database
	# Throws a warning if they're not.
	if (!is.na(highlights[1])) {
        for (k in 1:length(highlights)) {
            if(sum(grepl(highlights[k], mnnom$name)) == 0) {
                stop(paste("No lawmaker named \"",highlights[k],"\" in the database.", sep=""))
            }
        }
    }

	# Create the image file
    if(is.na(highlights[1])) { # Check to see if there are highlights
        png("mnleg-nominate.png", width=2000, height=2000, res=250) # If not, title the file simply
        } else {
        png( # Otherwise title it based on the first lawmaker mentioned, plus the number of additional lawmakers
            paste0(
                "mnleg-nominate_",
                highlights[1],"+",
                length(highlights)-1,
                ".png"),
            width=2000, height=2000, res= 250)
        }

	# Start graphing
	par(mar=c(2,4.2,4,2)) # Set margins
	plot( # Plot data
		mnnom$coord1D, # Ideology as y-axis.
		# X-axis isn't mentioned so defaults to rank-order
		pch=20, # Shape
		xaxt = "n", # Suppress x-axis
		yaxt="n", # Suppress y-axis
		ylab = "Ideology estimate", # Y-axis label
		main = "Ideology in 2015-16 Minnesota House of Representatives", # Title
		cex=.6) # Size

	# Draw horizontal lines at the median ideologies for each party
	abline(h=median(mnnom.r$coord1D), lty=3)
	abline(h=median(mnnom.d$coord1D), lty=3)

	# Plot Democrats in blue
	points(
		mnnom.d$coord1D, # Y-coordinates from the Democrats data frame
		pch=20, # Shape
		col="blue", # Color
		cex=.6) # Size

	# Plot Republicans in red
	points(
		c(65:137), # Manually specify x-coordinates
		mnnom.r$coord1D, # Y-coordinates from the Republicans data frame
		pch=20, # Shape
		col="red", # Color
		cex=.6) # Size

	abline(h=0, lty=1) # Horizontal line at ideology = 0

	# Label the median DFL and GOP lines created above
	text(
		100, # X-coordinate set manually
		median(mnnom.d$coord1D), # Y-coordinate at median for party
		"Median DFL lawmaker", # Label
		pos=3, # Text located above specified coordinates
		cex=.5, # Font size
		offset=.2, # Offset slightly from the line
		font=3) # Italics
	text(
		35,
		median(mnnom.r$coord1D),
		"Median GOP lawmaker",
		pos=3,
		cex=.5,
		offset=.2,
		font=3)

	# Add labels to the y-axis
	mtext( # Label the top
		"More conservative", # Label
		side=2, # Left side
		line=3, # Distance from edge of plot
		adj=1, # Justified to the top of the axis
		cex= .7) # Size
	mtext( # And the bottom
		"More liberal",
		side=2, # Left side
		line=3, # Distance from the edge of plot
		adj=0, # Justified to the bottom of the axis
		cex = .7) # Size

	# Label the x-axis
	mtext("Order", side=1, line=.2)

	# Subtitle
	mtext(
		"Estimated using W-NOMINATE method by Keith Poole, Jeffrey Lewis, James Lo & Royce Carroll", # Label
		cex=0.7, # Size
		line=0.5) # Distance from the edge of plot

	# Credit line
	text(
		140, # X-coordinate, near right edge of plot
		-1, # Y-coordinate, at bottom of plot
		"Graphic by David H. Montgomery\nPioneer Press", # Label
		pos=2, # Located to the left of the specified coordinate
		cex=.5) # Size

	# Add left axis
	axis(
		2, # Left side
		at = seq(-1, 1, .2), # From -1 to 1 by increments of 0.2
		lwd = 0, # No axis line
		lwd.ticks = 1, # Axis tick width
		las = 1, # Horizontal label orientation
		cex.axis=.8) # Font size

	# If you've selected any lawmakers to highlight, draw them
	if (!is.na(highlights[1])) { # Check to see if there are any highlights; if not, skip this whole step.
        # Create an empty list as long as the number of lawmakers you want to highlight
        l <- vector(
        	"list",
        	length(highlights))
        yl <- l # Create a copy of the list to store y-coordinates in
        # Fill out our x-coordinates
        for (i in 1:length(highlights)) { # Cycle through each highlight
            l[i] <- which(mnnom$name == highlights[i]) # Fill each position in L with the row number of each specified lawmaker name
            # This will be the x-coordinate for each point
            }
        xl <- as.numeric(l) # Store this and coerce to numeric
        # Fill out our y-coordinates
        # No need to cycle through with names this time, since we've already extracted the row names above.
        for (j in 1:length(l)) { yl[j] <- mnnom[xl[j],4] } # Write the ideology estimate for each lawmaker into the list yl.
        yl <- as.numeric(yl) # Coerce to numeric
        # Create a data frame from our x and y coordinates, plus the names
        signif <- data.frame(
            "name" = highlights, # Name column from specified highlights
            x = xl, # X-coordinates
            y = yl # Y-coordinates
        )
        # Draw the points
        points(
        	signif$x, # X-coordinates set above
        	signif$y, # Y-coordinates set above
        	col="black", # Black color
        	pch=19, # Shape
        	cex=1) # Size — bigger than the normal plots, for emphasis
        # Label each point
        # This includes some conditionals to make sure labels near the left or right side of the chart don't go outside the boundary
        text(
            ifelse(signif$x<40, signif$x+5, signif$x-5), # For Democrats near the extreme left, center the label to the right of the point. Otherwise, put it to the left.
            signif$y, # Y-coordinate
            labels= signif$name, # Label
            cex=0.7, # Font size
            pos= ifelse(signif$x<40,4,2), # For Democrats near the extreme left, put the label to the right side of its coordinates. Otherwise, put it to the left.
            adj = ifelse(signif$x<40, 1,0) # For Democrats near the extreme left, justify the label right; otherwise, justify left.
        )
    }
    # Close the image and finish.
	dev.off()
}


incarceration_trends <- read.csv("https://raw.githubusercontent.com/vera-institute/incarceration-trends/master/incarceration_trends.csv")

incarceration_trends_jail_jurisdiction <- read.csv("https://raw.githubusercontent.com/vera-institute/incarceration-trends/master/incarceration_trends_jail_jurisdiction.csv")

#Trends over time code

Black_pop <- incarceration_trends[, "black_jail_pop"]
na.omit(Black_pop)

Black_pop_WA <- incarceration_trends %>%
  select(state, black_jail_pop, year) %>%
  filter(state == "WA") %>%
  filter(1990 <= year & year <= 2000) %>%
  na.omit(Black_pop_WA)
Black_pop_WA

total_black_pop <- sum(incarceration_trends$black_jail_pop, na.rm = TRUE)
total_black_pop

#Chart of trends over time
chart_over_time <- ggplot(data = incarceration_trends) +
  geom_point(mapping = aes(x = year, y = Black_pop, color = "WA"))
chart_over_time

#Chart comparing two variables

white_incarceration <- incarceration_trends[, "white_jail_pop"]
na.omit(white_incarceration)

latinx_incarceration <- incarceration_trends[, "latinx_jail_pop"]
na.omit(latinx_incarceration)

latinx_white_chart <- ggplot(data = incarceration_trends) +
  geom_line(mapping = aes(x = year, y = latinx_incarceration, color = "latinx_incarceration")) +
  geom_line(mapping = aes(x = year, y = white_incarceration, color = "white_incarceration")) +
  labs(
    x = "year",
    y = "Number Incarcerated"
  )
latinx_white_chart

#total female incarceration
total_female_pop <- sum(incarceration_trends$female_jail_pop, na.rm = TRUE)
total_female_pop

#total latinx incarceration
total_latinx_pop <- sum(incarceration_trends$latinx_jail_pop, na.rm = TRUE)
total_latinx_pop

#map that shows measure of interest

Male_incarceration <- incarceration_trends[, "male_jail_pop"]
na.omit(Male_incarceration)

Male_states <- incarceration_trends %>%
  select(state, male_jail_pop, year) %>%
  na.omit()
Male_states

highest_year_Male <- incarceration_trends %>%
  group_by(year) %>%
  summarize(male_pop = sum(male_jail_pop, na.rm = TRUE)) %>%
  filter(male_pop == max(male_pop)) %>%
  pull(year)
highest_year_Male

incarcerated_2003 <- incarceration_trends %>%
  filter(year == 2003) %>%
  select(male_jail_pop)
incarcerated_2003

map_male_pop <- incarceration_trends %>%
  filter(year == 2003) %>%
  na.omit()
map_male_pop

highest_state_Male <- incarceration_trends %>%
  group_by(state) %>%
  summarize(male_pop = sum(male_jail_pop, na.rm = TRUE)) %>%
  filter(male_pop == max(male_pop)) %>%
  pull(state)
highest_state_Male

blank_theme <- theme_bw() +
  theme(
    axis.line = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    axis.title = element_blank(),
    plot.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank()
  )

state_shape <- map_data("state")
state_shape

Male_states

max_male <- max(incarceration_trends$male_jail_pop, na.rm = TRUE)

median_male <- median(incarceration_trends$male_jail_pop, na.rm = TRUE)

min_male <- min(incarceration_trends$male_jail_pop, na.rm = TRUE)

male_map <- ggplot(state_shape) +
  geom_polygon(
    mapping = aes(x = lag, y = lat, group = group, fill = median_male),
    color = "white",
    size = .2
  ) +
  coord_map() +
  scale_fill_continuous(low = "blue", high = "Red") +
  labs(fill = "male population") +
  blank_theme

male_map


# Correction in compute.cell.Chi2 when df=0.
# reported to package maintainers on 2016-09-18

#############################################################################
#   Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the
#   Free Software Foundation, Inc.,
#   59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
#
#############################################################################
### calculate goodness-of-fit statistics for
### fit of a parametric distribution on non-censored data
###
###         R functions
###

mygofstat <- function (f, chisqbreaks, meancount, discrete,
	fitnames=NULL)
{
	if(inherits(f, "fitdist"))
    {
        f <- list(f)
    }else if(length(f) == 1)
    {
        if(!inherits(f, "fitdist"))
		stop("argument f must a 'fitdist' object or a list of 'fitdist' objects.")
    }else if(!is.list(f))
    {
        stop("argument f must be a list of 'fitdist' objects")
    }else
    {
        if(any(sapply(f, function(x) !inherits(x, "fitdist"))))
		stop("argument f must be a list of 'fitdist' objects")
    }

  # In the future developments, it will be necessary to check that all the fits share the same weights
  if(!is.null(f[[1]]$weights))
    stop("gofstat is not yet available when using weights")

	odata <- f[[1]]$data
	sdata <- sort(odata)
	n <- f[[1]]$n
	distname <- f[[1]]$distname
	pdistname <- paste("p", distname, sep="")
	estimate <- f[[1]]$estimate
	fix.arg <- f[[1]]$fix.arg

    verif.ftidata <- function(fti)
    {
        if (any(fti$data != odata))
			stop("All compared fits must have been obtained with the same dataset")
        invisible()
    }
    lapply(f, verif.ftidata)

    # initiate discrete if not given
	if(missing(discrete))
	{
      discrete <- f[[1]]$discrete
	}
	if(!is.logical(discrete))
		stop("wrong argument 'discrete'.")

	#define chisqbreaks if not defined
	if (missing(chisqbreaks)) {
		if (missing(meancount))
		meancount <- round( n / ((4*n)^(2/5)) )
		if (length(sdata)>ceiling(1.5*meancount)) {
			limit <- sdata[meancount]
			sdata <- sdata[sdata>limit]
			chisqbreaks <- limit
		}
		else {
			warnings("The sample is too small to automatically define chisqbreaks")
			chisq <- NULL
			chisqbreaks <- NULL
			chisqpvalue <- NULL
			chisqtable <- NULL
			chisqdf <- NULL

		}
		while (length(sdata)>ceiling(1.5*meancount)) {
			limit <- sdata[meancount]
			sdata <- sdata[sdata>limit]
			chisqbreaks <- c(chisqbreaks,limit)
		}
		sdata <- sort(odata)
	}

	nbfit <- length(f)

	if(is.null(fitnames))
		fitnames <- paste(1:nbfit, sapply(f, function(x) x$method),
						  sapply(f, function(x) x$distname), sep="-")

	Chi2 <- compute.gofstat.Chi2(sdata, n, distname, pdistname, estimate, fix.arg,
								 chisqbreaks)
	if(length(f) > 1)
	{
		#renaming
		names(Chi2$chisq) <- names(Chi2$chisqpvalue) <- names(Chi2$chisqdf) <- fitnames[1]
		colnames(Chi2$chisqtable)[2] <- paste("theo", fitnames[1], sep=" ")

		#computation and storing
		for(i in 2:nbfit)
		{
			Chi2temp <- compute.gofstat.Chi2(sdata, n, f[[i]]$distname, paste("p", f[[i]]$distname, sep=""),
											 f[[i]]$estimate, f[[i]]$fix.arg, chisqbreaks)

			names(Chi2temp$chisq) <- names(Chi2temp$chisqpvalue) <- names(Chi2temp$chisqdf) <- fitnames[i]
			Chi2$chisq <- c(Chi2$chisq, Chi2temp$chisq)
			Chi2$chisqpvalue <- c(Chi2$chisqpvalue, Chi2temp$chisqpvalue)
			Chi2$chisqdf <- c(Chi2$chisqdf, Chi2temp$chisqdf)

			Chi2$chisqtable <- cbind(Chi2$chisqtable, Chi2temp$chisqtable[,2])
			colnames(Chi2$chisqtable)[NCOL(Chi2$chisqtable)] <- paste("theo", fitnames[i], sep=" ")
		}
	}

	if(discrete)
	{
		addres <- Chi2

	}else
	{
		KSCvMAD <- compute.gofstat.KSCvMAD(sdata, n, distname, pdistname, estimate,
										   fix.arg, f[[1]]$method)
		#renaming
		names(KSCvMAD$cvm) <- names(KSCvMAD$ad) <- names(KSCvMAD$ks) <- fitnames[1]

		if(!is.null(KSCvMAD$cvmtest))
		names(KSCvMAD$cvmtest) <- names(KSCvMAD$adtest) <- names(KSCvMAD$kstest) <- fitnames[1]

		if(length(f) > 1)
		{
			#computation and storing
			for(i in 2:nbfit)
			{
				KSCvMADtemp <- compute.gofstat.KSCvMAD(sdata, n, f[[i]]$distname, paste("p", f[[i]]$distname, sep=""),
													   f[[i]]$estimate, f[[i]]$fix.arg, f[[i]]$method)

				names(KSCvMADtemp$cvm) <- names(KSCvMADtemp$ad) <- names(KSCvMADtemp$ks) <- fitnames[i]

				if(!is.null(KSCvMADtemp$cvmtest))
					names(KSCvMADtemp$cvmtest) <- names(KSCvMADtemp$adtest) <- names(KSCvMADtemp$kstest) <- fitnames[i]

				KSCvMAD$cvm <- c(KSCvMAD$cvm, KSCvMADtemp$cvm)
				KSCvMAD$cvmtest <- c(KSCvMAD$cvmtest, KSCvMADtemp$cvmtest)
				KSCvMAD$ad <- c(KSCvMAD$ad, KSCvMADtemp$ad)
				KSCvMAD$adtest <- c(KSCvMAD$adtest, KSCvMADtemp$adtest)
				KSCvMAD$ks <- c(KSCvMAD$ks, KSCvMADtemp$ks)
				KSCvMAD$kstest <- c(KSCvMAD$kstest, KSCvMADtemp$kstest)

			}
		}

		addres <- c(Chi2, KSCvMAD)
	}

	aics <- sapply(f, function(x) x$aic)
	names(aics) <- fitnames
	bics <- sapply(f, function(x) x$bic)
	names(bics) <- fitnames

    res <- c(addres, aic=list(aics), bic=list(bics), discrete=discrete, nbfit=nbfit)
	class(res) <- c("gofstat.fitdist", "fitdist")
	res
}

#----------------------------------------------------------------------
#KS, CvM, AD statistics : only for continuous distributions
compute.gofstat.KSCvMAD <- function(sdata, n, distname, pdistname, estimate,
	fix.arg, method)
{

	obspu <- seq(1,n)/n
    obspl <- seq(0,n-1)/n
    theop <- do.call(pdistname, c(list(q=sdata), as.list(estimate), fix.arg))

	# Kolmogorov-Smirnov statistic
	ks <- max(pmax(abs(theop-obspu), abs(theop-obspl)))
	Dmod <- ks*(sqrt(n)+0.12+0.11/sqrt(n))
	# Kolmogorov-Smirnov test
	if (n>=30)
		kstest <- ifelse(Dmod>1.358,"rejected","not rejected")
	else
		kstest <- "not computed"

	# Anderson-Darling statistic
	ad <- - n - mean( (2 * 1:n - 1) * (log(theop) + log(1 - rev(theop))) )

		# ad <-  -n-sum((2*(1:n)-1)*log(theop) + (2*n+1-2*(1:n))*log(1-theop))/n

	# Anderson-Darling test
	if (is.null(fix.arg) & method == "mle")
	{
		# the following test does not correspond to MLE estimate but to unbiased
		# estimate of the variance
		#if ((distname == "norm" | distname == "lnorm") & n>=5) {
		#  a2mod <- ad*(1+0.75/n+2.25/n^2)
		#  adtest <- ifelse(a2mod>0.752,"rejected","not rejected")
		#}
		#else
		if (distname == "exp" & n>=5) {
			a2mod <- ad*(1+0.6/n)
			adtest <- ifelse(a2mod>1.321, "rejected", "not rejected")
		}
		else
		if (distname == "gamma" & n>=5) {
			m <- as.list(estimate)$shape
			interp <- approxfun(c(1,2,3,4,5,6,8,10,12,15,20),
								c(0.786,0.768,0.762,0.759,0.758,0.757,0.755,0.754,0.754,0.754,0.753),
								yright=0.752)
			adtest <- ifelse(ad>interp(m), "rejected", "not rejected")
		}
		else
		if (distname == "weibull" & n>=5) {
			a2mod <- ad*(1+0.2/sqrt(n))
			adtest <- ifelse(a2mod>0.757, "rejected", "not rejected")
		}
		else
		if (distname == "logis" & n>=5) {
		   a2mod <- ad*(1+0.25/n)
		   adtest <- ifelse(a2mod>0.66,"rejected","not rejected")
		}
		# else
		# the following test does not correspond to MLE estimate
		#   if (distname == "cauchy" & n>=5) {
		# 	interp <- approxfun(c(5,8,10,12,15,20,25,30,40,50,60,100),
		# 						c(1.77,3.2,3.77,4.14,4.25,4.05,3.57,3.09,2.48,2.14,1.92,1.52),
		# 						yright=1.225)
		# 	adtest <- ifelse(ad>interp(n), "rejected", "not rejected")
		# }
		else adtest <- "not computed"
	}  # if (is.null(fix.arg)...)
	else
		adtest <- "not computed"

	# Cramer-von Mises statistic
	cvm <- 1/(12*n) + sum( ( theop - (2 * 1:n - 1)/(2 * n) )^2 )

	# Cramer-von Mises test
	if (is.null(fix.arg) & method == "mle")
	{
		# the following test does not correspond to MLE estimate but to unbiased
		# estimate of the variance
		# if ((distname == "norm" | distname == "lnorm") & n>=5) {
		#  w2mod <- cvm*(1+0.5/n)
		#  cvmtest <- ifelse(w2mod>0.126,"rejected","not rejected")
		# }
		# else
		if (distname == "exp" & n>=5) {
			w2mod <- cvm*(1+0.16/n)
			cvmtest <- ifelse(w2mod>0.222,"rejected","not rejected")
		}
		else
		if (distname == "gamma" & n>=5) {
			m <- as.list(estimate)$shape
			interp <- approxfun(c(1,2,3,4,5,6,8,10,12,15,20),
								c(0.136,0.131,0.129,0.128,0.128,0.128,0.127,0.127,0.127,0.127,0.126),
								yright=0.126)
			cvmtest <- ifelse(cvm>interp(m),"rejected","not rejected")
		}
		else
		if (distname == "weibull" & n>=5) {
			w2mod <- cvm*(1+0.2/sqrt(n))
			cvmtest <- ifelse(w2mod>0.124,"rejected","not rejected")
		}
		else
		if (distname == "logis" & n>=5) {
		    w2mod <- (n*cvm - 0.08)/(n - 1)
		    cvmtest <- ifelse(w2mod>0.098,"rejected","not rejected")
		}
		# else
		# not with an MLE estimate in Stephens
		# if (distname == "cauchy" & n>=5) {
		# 	interp <- approxfun(c(5,8,10,12,15,20,25,30,40,50,60,100),
		# 						c(0.393,0.703,0.833,0.896,0.904,0.835,0.726,0.615,0.460,0.381,0.330,0.2378),
		# 						yright=0.170)
		# 	cvmtest <- ifelse(cvm>interp(n),"rejected","not rejected")
		# }
		else cvmtest <- "not computed"
	}  # if (is.null(fix.arg))
	else
		cvmtest <- "not computed"

	if (length(table(sdata)) != length(sdata))
		warnings("Kolmogorov-Smirnov, Cramer-von Mises and Anderson-Darling statistics may not be correct with ties")

	list(cvm = cvm, cvmtest = cvmtest, ad = ad,adtest = adtest, ks = ks, kstest=kstest)
}

#----------------------------------------------------------------------
#chi-squared statistic : both for continuous and discrete distributions
compute.gofstat.Chi2 <- function(sdata, n, distname, pdistname, estimate, fix.arg, chisqbreaks)
{
	# chi-squared statistic and pvalues
	if (!is.null(chisqbreaks)) {
		if(!is.numeric(chisqbreaks))
			stop("chisqbreaks must be a numeric vector defining the cell boundaries")

		nbreaks <- length(chisqbreaks)
		pbreaks <- do.call(pdistname, c(list(q=chisqbreaks), as.list(estimate), fix.arg))
		Fobsbreaks <- ecdf(sdata)(chisqbreaks)

		Fobsunder <- c(0, Fobsbreaks[1:nbreaks-1])
		punder <- c(0, pbreaks[1:nbreaks-1])
		if (pbreaks[nbreaks]==1 & Fobsbreaks[nbreaks]==1)
		{
			p <- pbreaks-punder
			Fobs <- Fobsbreaks-Fobsunder
		}else
		{
			p <- c(pbreaks-punder, 1-pbreaks[nbreaks])
			Fobs <- c(Fobsbreaks-Fobsunder, 1-Fobsbreaks[nbreaks])
		}

		obscounts <- round(Fobs*n)
		theocounts <- p*n

		chisq <- sum(((obscounts-theocounts)^2)/theocounts)
		chisqdf <- length(obscounts)-1-length(estimate)

		#browser() ***** ERROR HERE WHEN DF is 0 ******
		chisqpvalue <- ifelse(chisqdf>0, pchisq(chisq, df=chisqdf, lower.tail=FALSE), NA)

		chisqtable <- as.table(cbind(obscounts, theocounts))
		for (i in 1:length(obscounts)-1)
			rownames(chisqtable)[i] <- paste("<=", signif(chisqbreaks[i], digits=4))
		rownames(chisqtable)[length(obscounts)] <- paste(">", signif(chisqbreaks[i], digits=4))

		return( list(chisq = chisq, chisqbreaks=chisqbreaks, chisqpvalue = chisqpvalue,
					 chisqdf = chisqdf, chisqtable = chisqtable) )
	}else
		return(NULL)
}

print.gofstat.fitdist <- function(x, ...)
{
    if (!inherits(x, "gofstat.fitdist"))
		stop("Use only with 'gofstat.fitdist' objects")

	if (x$discrete) #discrete distribution
    {
        if(!is.null(x$chisq))
        {
            cat("Chi-squared statistic: ",x$chisq,"\n")
			cat("Degree of freedom of the Chi-squared distribution: ",x$chisqdf,"\n")
			if (any(x$chisqdf <= 0))
			{
				cat("  The degree of freedom of the chi-squared distribution is less than 1  \n")
				cat("  The number of cells is insufficient to calculate the p-value.  \n")
			}
			else
			{
				cat("Chi-squared p-value: ",x$chisqpvalue,"\n")
				if (any(x$chisqtable[,-1] < 5))
					cat("   the p-value may be wrong with some theoretical counts < 5  \n")
			}

			cat("Chi-squared table:\n")
			print(x$chisqtable)

			cat("\nGoodness-of-fit criteria\n")
			mm <- rbind(AIC=x$aic, BIC=x$bic)
			rownames(mm) <- c("Aikake's Information Criterion",
							  "Bayesian Information Criterion")
			print(mm)
        }
        else
			cat("The sample is too small to automatically define cells for Chi-squared test \n")
    }else # continuous distribution
    {
			cat("Goodness-of-fit statistics\n")
			mm <- rbind(KS=x$ks, CvM=x$cvm, AD=x$ad)
			rownames(mm) <- c("Kolmogorov-Smirnov statistic", "Cramer-von Mises statistic",
							  "Anderson-Darling statistic")
			print(mm)

			cat("\nGoodness-of-fit criteria\n")
			mm <- rbind(AIC=x$aic, BIC=x$bic)
			rownames(mm) <- c("Aikake's Information Criterion",
							  "Bayesian Information Criterion")
			print(mm)
#		}

    }

	invisible(x)
}


#### expm(t*x)y, x matrix, y vector
#slepc_expm <- function(t, x_dim, x_ldim, x_data, x_row_ptr, x_col_ind, y_length, y_llength, y_data, y_row_ptr, y_col_ind)
#{
#  storage.mode(t) <- "double"
#  storage.mode(x_dim) <- "integer"
#  storage.mode(x_ldim) <- "integer"
#  storage.mode(x_data) <- "double"
#  storage.mode(x_row_ptr) <- "integer"
#  storage.mode(x_col_ind) <- "integer"
#  storage.mode(y_length) <- "integer"
#  storage.mode(y_llength) <- "integer"
#  storage.mode(y_data) <- "double"
#  storage.mode(y_row_ptr) <- "integer"
#  storage.mode(y_col_ind) <- "integer"
#
#  x_data <- x_data * t
#
#  out <- .Call(slepc_expm, t,
#            x_dim, x_ldim, x_data, x_row_ptr, x_col_ind,
#            y_length, y_llength, y_data, y_row_ptr, y_col_ind)
#
#  return( out )
#}