#!/usr/bin/env Rscript

args = commandArgs(trailingOnly=TRUE)

if(length(args) != 2){
    stop("Usage: dada_quality.r <str; output prefix> <int; The number of records to sample from the fastq file.>")
}

OUT <- args[1]
number_of_records <- as.integer(args[2])

print(OUT)
print(number_of_records)

suppressPackageStartupMessages(library(dada2))

readfiles <- sort(list.files(".", pattern = ".fastq.gz", full.names = TRUE))
plot <- plotQualityProfile(readfiles, n = number_of_records, aggregate = TRUE)
data <- plot$data

df <- data.frame(Cycle=character(), Count=character(), Median=character(), stringsAsFactors=FALSE)
cycles <- sort(unique(data$Cycle))

#aggregate data for each sequencing cycle
for (cycle in cycles) {
    subdata <- data[data[, "Cycle"] == cycle, ]
    score <- list()
    #convert to list to calculate median
    for (j in 1:nrow(subdata)) {score <- unlist(c(score, rep(subdata$Score[j], subdata$Count[j])))}
    temp = data.frame(Cycle=cycle, Count=sum(subdata$Count), Median=median(score), stringsAsFactors=FALSE)
    df <- rbind(df, temp)
}

#write output
write.table( t(df), file = paste0(OUT,".tsv"), sep = "\t", row.names = TRUE, col.names = FALSE, quote = FALSE)
pdf(paste0(OUT,".pdf"))
plot
dev.off()


x <- 1:20
y <- 1:20

svg("linear.svg")

plot(x, y, type = "b", xlab = "Input Size", ylab = "Runtime / Complexity", pch = 20)


library('ineq')
args <- commandArgs(trailingOnly = TRUE)

if (length(args) != 2) {
    print('Usage: Rscript plot_lorenz_curve_for_defect_densities.r <path/to/data_dir> <project_name>')
    print('E.g. : Rscript plot_lorenz_curve_for_defect_densities.r data/ bitcoin')
} else if (length(args) == 2) {
    data_dir <- args[1]
    project_name <- args[2]

    instance_data_dir <- paste(data_dir, 'ast_node_instances', project_name, sep='/')
    if (!dir.exists(instance_data_dir)) {
        print(paste('Error! Instance data for project `', project_name, '` not found. Aborting!', sep=''))
        break
    }

    csv_file_names = list.files(instance_data_dir, pattern='csv$')
    csv_file_paths = paste(instance_data_dir, csv_file_names, sep='/')

    ## node_types = c('do', 'while', 'for', 'if', 'else', 'switch', 'root', 'function', 'error', 'block')
    node_types = c('do', 'while', 'for', 'if', 'else', 'switch', 'root', 'function')
    for (nt in node_types) {

        plots_dir_1 <- paste('plots', 'num_bugs_vs_num_lines_lorenz', project_name, nt, sep='/')
        if (!dir.exists(plots_dir_1)) {
            dir.create(plots_dir_1, recursive=TRUE)
        }

        plots_dir_2 <- paste('plots', 'frac_buggy_lines_lorenz', project_name, nt, sep='/')
        if (!dir.exists(plots_dir_2)) {
            dir.create(plots_dir_2, recursive=TRUE)
        }

        for (i in seq(1, (length(csv_file_paths)))) {
            csv_data = read.csv(csv_file_paths[i])
            csv_data_nt_only = csv_data[which(csv_data$node_type==nt & csv_data$num_buggy_lines>0, ),
                                        c('num_distinct_bugs', 'num_total_lines', 'frac_buggy_lines')]

            png(paste(plots_dir_1, '/', csv_file_names[i], '.png', sep=''))
            plot(Lc(x=csv_data_nt_only$num_distinct_bugs, n=csv_data_nt_only$num_total_lines), col='darkred', lwd=2)
            foo = dev.off()

            png(paste(plots_dir_2, '/', csv_file_names[i], '.png', sep=''))
            plot(Lc(x=csv_data_nt_only$frac_buggy_lines), col='darkred', lwd=2)
            foo = dev.off()

            # gini = ineq(dds$dd, type='Gini')
        }
    }
}


# PAWS preprocessing - distance
# Lily Xu
# December 2018

### setup
library(sp)
library(rgeos)
library(rgdal)
library(raster)
library(maptools)

outFilepath  <- paste(path, outputPath, "distance/", sep="")

# create 'distance' folder if it does not exist
if (!dir.exists(outFilepath)) {
  dir.create(outFilepath, recursive=TRUE)
}

# boundary needs its own function because the park boundary shapefile is a filled polygon
# so it would say distance to the polygon is 0 everywhere
computeDistanceToBoundary <- function(dataGridPixels, rast, boundary, outFilepath) {
  distance <- numeric(ncell(rast))
  for (i in seq_len(ncell(rast))) {
    distance[i] <- gDistance(dataGridPixels[i,], as(boundary, "SpatialLines"), byid=TRUE)
  }
  values(rast) <- distance

  # set everything outside of the protected area to NA
  rasterMask <- mask(rast, boundary)
  rasterCSV <- as.data.frame(rasterMask, xy=TRUE)

  # ensure x, y values are ints, not floats
  rasterCSV["x"] <- round(rasterCSV["x"], 0)
  rasterCSV["y"] <- round(rasterCSV["y"], 0)

  rasterMaskCSV <- na.omit(rasterCSV)
  rasterFilename <- paste(outFilepath, "/boundary.csv", sep="")
  write.csv(rasterMaskCSV, file=rasterFilename)

  return(rasterMask)
}

computeDistanceToShapeMask <- function(dataGridPixels, rast, shape, boundary, outFilepath, filenamePrefix) {
  # compute distance of each grid cell to the shape
  distance <- numeric(ncell(rast))
  for (i in seq_len(ncell(rast))) {
    distance[i] <- gDistance(dataGridPixels[i,], shape)
  }
  values(rast) <- distance

  # maybe just rast[i] <- gDistance? (no need to make distance)

  # set everything outside of the protected area to NA
  rasterMask <- mask(rast, boundary)
  shapeCSV <- as.data.frame(rasterMask, xy=TRUE)

  # ensure x, y values are ints, not floats
  shapeCSV["x"] <- round(shapeCSV["x"], 0)
  shapeCSV["y"] <- round(shapeCSV["y"], 0)

  shapeCroppedCSV <- na.omit(shapeCSV)
  shapeCroppedFilename <- paste(outFilepath, filenamePrefix, ".csv", sep="")
  write.csv(shapeCroppedCSV, file=shapeCroppedFilename)

  return(rasterMask)
}

computeAllDistances <- function(boundary, shapes, dataGridPixels, rast, outFilepath) {
  shapeNames <- names(shapes)
  shapeDistances <- list()

  # distance to boundary
  shapeDistances["boundary"] <- computeDistanceToBoundary(dataGridPixels, rast, boundary, outFilepath)

  # distance to each additional shape
  for (i in 1:length(shapes)) {
    print(paste("processing", i, ", ", shapeNames[i], "..."))
    shape <- shapes[[i]]

    shapeDist <- computeDistanceToShapeMask(dataGridPixels, rast, shape, boundary, outFilepath, shapeNames[i])

    shapeDistances[shapeNames[i]] <- shapeDist
  }

  return(shapeDistances)
}

# TODO: switch to stack of rasters, then use writeRaster with bylayer=TRUE

# save PNG visualizing all distance maps
visualizeDistance <- function(outFilepath, shapeDistances, boundary) {
  shapeNames <- names(shapeDistances)
  numCols <- ceiling(length(shapeDistances) / 2)

  png(file=paste(outFilepath, "plot_distances.png", sep=""), width=450*numCols, height=900)
  par(mfrow=c(2, numCols))

  for (i in 1:length(shapeDistances)) {
    print(paste("processing", i, ", ", shapeNames[i], "..."))

    plot(shapeDistances[[i]], main=shapeNames[i], cex.main=2)
    lines(boundary)
  }

  dev.off()
}

rast <- loadGridRast(gridFilename, crs_use)
dataGridPixels <- loadGridSpatialPixels(gridFilename, crs_use)

shapes <- getDistanceShapes(inputPath)
shapeDistances <- computeAllDistances(boundary, shapes, dataGridPixels, rast, outFilepath)
visualizeDistance(outFilepath, shapeDistances, boundary)


#!/usr/bin/env Rscript

f1="./sheet1.csv";
f2="./sheet2.csv";
f3="./sheet3.csv";

res1 = read.csv(f1, sep=',',header=TRUE);
res2 = read.csv(f2, sep=',',header=TRUE);
res3 = read.csv(f3, sep=',',header=TRUE);

img_xlab = "log2(fold_change)";
img_ylab = "-log10(p.Value)";

p1="./image1.pdf";
p2="./image2.pdf";
p3="./image3.pdf";
p4="./image4.pdf";
p5="./image5.pdf";

pdf(p1,width=60,height=40);
par(mai=c(5,5,5,5),mgp=c(3, 3, 0));
with(res1,plot(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab=""));
with(res2,points(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab="",col="red"));
mtext('black dots of sheet1 red dots of sheet2',side=3,line=8,cex=6);
mtext(img_xlab,side=1,line=8,cex=6);
mtext(img_ylab,side=2,line=8,cex=6);
dev.off();

pdf(p2,width=60,height=40);
par(mai=c(5,5,5,5),mgp=c(3, 3, 0));
with(res3,plot(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab="",col="green"));
mtext('green dots of sheet3',side=3,line=8,cex=6);
mtext(img_xlab,side=1,line=8,cex=6);
mtext(img_ylab,side=2,line=8,cex=6);
dev.off();

pdf(p3,width=60,height=40);
par(mai=c(5,5,5,5),mgp=c(3, 3, 0));
with(res1,plot(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab=""));
with(res2,points(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab="",col="red"));
with(res3,points(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab="",col="green"));
mtext('black dots of sheet1,red dots of sheet2 ,green dots of sheet3',side=3,line=8,cex=6);
mtext(img_xlab,side=1,line=8,cex=6);
mtext(img_ylab,side=2,line=8,cex=6);
dev.off();

pdf(p4,width=60,height=40);
par(mai=c(5,5,5,5),mgp=c(3, 3, 0));
with(res2,plot(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab="",col="red"));
mtext('red dots of sheet2',side=3,line=8,cex=6);
mtext(img_xlab,side=1,line=8,cex=6);
mtext(img_ylab,side=2,line=8,cex=6);
dev.off();

pdf(p5,width=60,height=40);
par(mai=c(5,5,5,5),mgp=c(3, 3, 0));
with(res1,plot(fold_change,-log10(p.Value),pch=19,cex=2,cex.axis=4,main="",xlab="",ylab=""));
mtext('black dots of sheet1',side=3,line=8,cex=6);
mtext(img_xlab,side=1,line=8,cex=6);
mtext(img_ylab,side=2,line=8,cex=6);
dev.off();


library(craze)
v = refvec()
x = refmat(5, 3)
x$fill_linspace(1, 2)
x

x$get_row(0, v)
v$info()
v

x$antidiag()


library(shiny)
library(ngram)

shinyServer(function(input, output, session){
  localstate <- reactiveValues()
  localstate$ng <- NULL
  localstate$tb <- capture.output(cat("Input the text you want to process in the box on the left."))

  observeEvent(input$button_process, {
    ### Fit
    localstate$ng <- NULL
    invisible(gc())

    localstate$ng <- ngram(str=input$inputbox, n=input$the_n_in_ngram)
    out <- gsub(x=capture.output(print(localstate$ng)), pattern="\\[1\\]|\"", replacement="")
    localstate$tb <- capture.output(cat(paste0("PROCESSED:  ", out, ".")))
  })

  ### Inspect
  observeEvent(input$button_inspect, {
    validate(
      need(!is.null(localstate$ng), "You must first process some input text.")
    )

    localstate$tb <- HTML(paste(capture.output(print(localstate$ng, output="truncated")), collapse="<br/>"))
  })

  ### Babble
  observeEvent(input$button_babble, {
    validate(
      need(!is.null(localstate$ng), "You must first process some input text."),
      need(input$ng_seed == "" || suppressWarnings(!is.na(as.integer(input$ng_seed))), "Seed must be a number or blank.")
    )

    seed <- input$ng_seed
    if (seed == "")
      seed <- ngram:::getseed()
    else
      seed <- as.integer(seed)

    localstate$tb <- capture.output(cat(babble(ng=localstate$ng, genlen=input$babble_len, seed=seed)))
  })

  output$text <- renderUI({
    localstate$tb
  })
})


library("SparkR")
library("microbenchmark")
library("magrittr")
library("ggplot2")
library("pryr")

sparkR.session(master = "local[*]", sparkConfig = list(spark.driver.memory = "2g"))

dir_path <- "results/"

# For benchmarking spark.lapply, we generate

#     lists

# 1. with different types (7):
#     Length = 100,
#     Type = integer,
#            logical,
#            double,
#            character1,
#            character10,
#            character100,
#            character1k.

data.list.type.double <- runif(100)
data.list.type.int <- as.integer(data.list.type.double * 100)
data.list.type.logical <- data.list.type.double < 0.5
data.list.type.char1 <- sapply(1:100, function(x) { "a" })
data.list.type.char10 <- sapply(1:100, function(x) { "0123456789" })
data.list.type.char100 <- sapply(1:100, function(x) { paste(replicate(20, "hello"), collapse = "") })
data.list.type.char1k <- sapply(1:100, function(x) { paste(replicate(200, "hello"), collapse = "") })

# 2. with different lengths (4):
#     Type = integer,
#     Length = 10,
#              100,
#              1k,
#              10k

data.list.len.10 <- 1:10
data.list.len.100 <- 1:100
data.list.len.1k <- 1:1000
data.list.len.10k <- 1:10000

# For benchmarking dapply+rnow/dapplyCollect, we generate

#     data.frame

# 1. with different types (7):
#     nrow = 100,
#     ncol = 1,
#     Type = integer,
#            logical,
#            double,
#            character1,
#            character10,
#            character100,
#            character1k.

data.df.type.double <- data.frame(data.list.type.double) %>% createDataFrame %>% cache
data.df.type.int <- data.frame(data.list.type.int) %>% createDataFrame %>% cache
data.df.type.logical <- data.frame(data.list.type.logical) %>% createDataFrame %>% cache
data.df.type.char1 <- data.frame(data.list.type.char1) %>% createDataFrame %>% cache
data.df.type.char10 <- data.frame(data.list.type.char10) %>% createDataFrame %>% cache
data.df.type.char100 <- data.frame(data.list.type.char100) %>% createDataFrame %>% cache
data.df.type.char1k <- data.frame(data.list.type.char1k) %>% createDataFrame %>% cache

# counting to materialize the cache
data.df.type.double %>% nrow
data.df.type.int %>% nrow
data.df.type.logical %>% nrow
data.df.type.char1 %>% nrow
data.df.type.char10 %>% nrow
data.df.type.char100 %>% nrow
data.df.type.char1k %>% nrow

# 2. with different lengths (4):
#     ncol = 1,
#     Type = integer,
#     nrow = 10,
#            100,
#            1k,
#            10k

data.df.len.10 <- data.frame(data.list.len.10) %>% createDataFrame %>% cache
data.rdf.len.100 <- data.frame(data.list.len.100)
data.df.len.100 <- data.rdf.len.100 %>% createDataFrame %>% cache
data.df.len.1k <- data.frame(data.list.len.1k) %>% createDataFrame %>% cache
data.df.len.10k <- data.frame(data.list.len.10k) %>% createDataFrame %>% cache

# counting to materialize the cache
data.df.len.10 %>% nrow
data.df.len.100 %>% nrow
data.df.len.1k %>% nrow
data.df.len.10k %>% nrow

# 3. with different ncols (3):
#     nrow = 100,
#     Type = integer,
#     ncol = 1,
#            10,
#            100

data.df.ncol.1 <- data.df.len.100
data.df.ncol.10 <- data.frame(rep(data.rdf.len.100, each = 10)) %>% createDataFrame %>% cache
data.df.ncol.100 <- data.frame(rep(data.rdf.len.100, each = 100)) %>% createDataFrame %>% cache

# counting to materialize the cache
data.df.ncol.1 %>% nrow
data.df.ncol.10 %>% nrow
data.df.ncol.100 %>% nrow

# For benchmarking gapply+rnow/gapplyCollect, we generate

#     data.frame

# 1. with different number of keys (3):
#     ncol = 2,
#     nrow = 1k,
#     Type = <integer, double>,
#     nkeys = 10,
#             100,
#             1000

data.rand.1k <- runif(1000)

data.df.nkey.10 <- data.frame(key = rep(1:10, 100), val = data.rand.1k) %>% createDataFrame %>% cache
data.df.nkey.100 <- data.frame(key = rep(1:100, 10), val = data.rand.1k) %>% createDataFrame %>% cache
data.df.nkey.1k <- data.frame(key = 1:1000, val = data.rand.1k) %>% createDataFrame %>% cache

# counting to materialize the cache
data.df.nkey.10 %>% nrow
data.df.nkey.100 %>% nrow
data.df.nkey.1k %>% nrow

# 2. with different lengths (4):
#     ncol = 2,
#     Type = <integer, double>,
#     nkeys = 10,
#     nrow = 10,
#            100,
#            1k,
#            10k

data.df.nrow.10 <- data.frame(key = 1:10, val = runif(10)) %>% createDataFrame %>% cache
data.df.nrow.100 <- data.frame(key = rep(1:10, 10), val = runif(100)) %>% createDataFrame %>% cache
data.df.nrow.1k <- data.frame(key = rep(1:10, 100), val = data.rand.1k) %>% createDataFrame %>% cache
data.df.nrow.10k <- data.frame(key = rep(1:10, 1000), val = runif(10000)) %>% createDataFrame %>% cache

# counting to materialize the cache
data.df.nrow.10 %>% nrow
data.df.nrow.100 %>% nrow
data.df.nrow.1k %>% nrow
data.df.nrow.10k %>% nrow

# 3. with different key types (3):
#     ncol = 2,
#     nkeys = 10,
#     nrow = 1k,
#     Type = <integer, double>
#            <character10, double>
#            <character100, double>

key.char10 <- sapply(1:10, function(x) { sprintf("%010d", x) })
key.char100 <- sapply(1:10, function(x) { sprintf("%0100d", x) })

data.df.keytype.int <- data.df.nrow.1k
data.df.keytype.char10 <- data.frame(key = rep(key.char10, 100), val = data.rand.1k) %>% createDataFrame %>% cache
data.df.keytype.char100 <- data.frame(key = rep(key.char100, 10), val = data.rand.1k) %>% createDataFrame %>% cache

# counting to materialize the cache
data.df.keytype.int %>% nrow
data.df.keytype.char10 %>% nrow
data.df.keytype.char100 %>% nrow

# ========== benchmark functions ==============

# plot utils
plot.box.mbm <- function(mbm_result) {
	ggplot(mbm_result, aes(x = expr, y = time/1000000)) +
	geom_boxplot(outlier.colour = "red", outlier.shape = 1) + labs(x = "", y = "Time (milliseconds)") +
	geom_jitter(position=position_jitter(0.2), alpha = 0.2) +
	coord_flip()
}
plot.box.throughput <- function(throughput_result) {
	ggplot(throughput_result, aes(x = expr, y = throughput)) +
	geom_boxplot(outlier.colour = "red", outlier.shape = 1) + labs(x = "", y = "Throughput (B/s)") +
	geom_jitter(position=position_jitter(0.2), alpha = 0.2) +
	coord_flip()
}

# dummy function
func.dummy <- function(x) { x }

# group function
gfunc.mean <- function(key, sdf) {
	y <- data.frame(key, mean(sdf$val), stringsAsFactors = F)
	names(y) <- c("key", "val")
	y
}

# lapply, type
run.mbm.spark.lapply.type <- function(n) {
	microbenchmark(
		"lapply.int.100" = { spark.lapply(data.list.type.int, func.dummy) },
		"lapply.double.100" = { spark.lapply(data.list.type.double, func.dummy) },
		"lapply.logical.100" = { spark.lapply(data.list.type.logical, func.dummy) },
		"lapply.char1.100" = { spark.lapply(data.list.type.char1, func.dummy) },
		"lapply.char10.100" = { spark.lapply(data.list.type.char10, func.dummy) },
		"lapply.char100.100" = { spark.lapply(data.list.type.char100, func.dummy) },
		"lapply.char1k.100" = { spark.lapply(data.list.type.char1k, func.dummy) },
		times = n
	)
}

# lapply, len
run.mbm.spark.lapply.len <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"lapply.len.10" = { spark.lapply(data.list.len.10, func.dummy) },
			"lapply.len.100" = { spark.lapply(data.list.len.100, func.dummy) },
			times = n
		)
	} else if (mode == "medium") {
		microbenchmark(
			"lapply.len.10" = { spark.lapply(data.list.len.10, func.dummy) },
			"lapply.len.100" = { spark.lapply(data.list.len.100, func.dummy) },
			"lapply.len.1k" = { spark.lapply(data.list.len.1k, func.dummy) },
			times = n
		)
	} else {
		microbenchmark(
			"lapply.len.10" = { spark.lapply(data.list.len.10, func.dummy) },
			"lapply.len.100" = { spark.lapply(data.list.len.100, func.dummy) },
			"lapply.len.1k" = { spark.lapply(data.list.len.1k, func.dummy) },
			"lapply.len.10k" = { spark.lapply(data.list.len.10k, func.dummy) },
			times = n
		)
	}
}

# dapply, type
run.mbm.dapply.type <- function(n) {
	microbenchmark(
		"dapply.int.100" = { dapply(data.df.type.int, func.dummy, schema(data.df.type.int)) %>% nrow },
		"dapply.double.100" = { dapply(data.df.type.double, func.dummy, schema(data.df.type.double)) %>% nrow },
		"dapply.logical.100" = { dapply(data.df.type.logical, func.dummy, schema(data.df.type.logical)) %>% nrow },
		"dapply.char1.100" = { dapply(data.df.type.char1, func.dummy, schema(data.df.type.char1)) %>% nrow },
		"dapply.char10.100" = { dapply(data.df.type.char10, func.dummy, schema(data.df.type.char10)) %>% nrow },
		"dapply.char100.100" = { dapply(data.df.type.char100, func.dummy, schema(data.df.type.char100)) %>% nrow },
		"dapply.char1k.100" = { dapply(data.df.type.char1k, func.dummy, schema(data.df.type.char1k)) %>% nrow },
		times = n
	)
}

# dapply, len
run.mbm.dapply.len <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"dapply.len.10" = { dapply(data.df.len.10, func.dummy, schema(data.df.len.10)) %>% nrow },
			"dapply.len.100" = { dapply(data.df.len.100, func.dummy, schema(data.df.len.100)) %>% nrow },
			times = n
		)
	} else if (mode == "medium") {
		microbenchmark(
			"dapply.len.10" = { dapply(data.df.len.10, func.dummy, schema(data.df.len.10)) %>% nrow },
			"dapply.len.100" = { dapply(data.df.len.100, func.dummy, schema(data.df.len.100)) %>% nrow },
			"dapply.len.1k" = { dapply(data.df.len.1k, func.dummy, schema(data.df.len.1k)) %>% nrow },
			times = n
		)
	} else {
		microbenchmark(
			"dapply.len.10" = { dapply(data.df.len.10, func.dummy, schema(data.df.len.10)) %>% nrow },
			"dapply.len.100" = { dapply(data.df.len.100, func.dummy, schema(data.df.len.100)) %>% nrow },
			"dapply.len.1k" = { dapply(data.df.len.1k, func.dummy, schema(data.df.len.1k)) %>% nrow },
			"dapply.len.10k" = { dapply(data.df.len.10k, func.dummy, schema(data.df.len.10k)) %>% nrow },
			times = n
		)
	}
}

# dapply, ncol
run.mbm.dapply.ncol <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"dapply.ncol.1" = { dapply(data.df.ncol.1, func.dummy, schema(data.df.ncol.1)) %>% nrow },
			"dapply.ncol.10" = { dapply(data.df.ncol.10, func.dummy, schema(data.df.ncol.10)) %>% nrow },
			times = n
		)
	} else {
		microbenchmark(
			"dapply.ncol.1" = { dapply(data.df.ncol.1, func.dummy, schema(data.df.ncol.1)) %>% nrow },
			"dapply.ncol.10" = { dapply(data.df.ncol.10, func.dummy, schema(data.df.ncol.10)) %>% nrow },
			"dapply.ncol.100" = { dapply(data.df.ncol.100, func.dummy, schema(data.df.ncol.100)) %>% nrow },
			times = n
		)
	}

}

# dapplyCollect, type
run.mbm.dapplyCollect.type <- function(n) {
	microbenchmark(
		"dapplyCollect.int.100" = { dapplyCollect(data.df.type.int, func.dummy) },
		"dapplyCollect.double.100" = { dapplyCollect(data.df.type.double, func.dummy) },
		"dapplyCollect.logical.100" = { dapplyCollect(data.df.type.logical, func.dummy) },
		"dapplyCollect.char1.100" = { dapplyCollect(data.df.type.char1, func.dummy) },
		"dapplyCollect.char10.100" = { dapplyCollect(data.df.type.char10, func.dummy) },
		"dapplyCollect.char100.100" = { dapplyCollect(data.df.type.char100, func.dummy) },
		"dapplyCollect.char1k.100" = { dapplyCollect(data.df.type.char1k, func.dummy) },
		times = n
	)
}

# dapplyCollect, len
run.mbm.dapplyCollect.len <- function(mode, n) {
	if (mode != "large") {
		microbenchmark(
			"dapplyCollect.len.10" = { dapplyCollect(data.df.len.10, func.dummy) },
			"dapplyCollect.len.100" = { dapplyCollect(data.df.len.100, func.dummy) },
			"dapplyCollect.len.1k" = { dapplyCollect(data.df.len.1k, func.dummy) },
			times = n
		)
	} else {
		microbenchmark(
			"dapplyCollect.len.10" = { dapplyCollect(data.df.len.10, func.dummy) },
			"dapplyCollect.len.100" = { dapplyCollect(data.df.len.100, func.dummy) },
			"dapplyCollect.len.1k" = { dapplyCollect(data.df.len.1k, func.dummy) },
			"dapplyCollect.len.10k" = { dapplyCollect(data.df.len.10k, func.dummy) },
			times = n
		)
	}
}

# dapplyCollect, ncol
run.mbm.dapplyCollect.ncol <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"dapplyCollect.ncol.1" = { dapplyCollect(data.df.ncol.1, func.dummy) },
			"dapplyCollect.ncol.10" = { dapplyCollect(data.df.ncol.10, func.dummy) },
			times = n
		)
	} else {
		microbenchmark(
			"dapplyCollect.ncol.1" = { dapplyCollect(data.df.ncol.1, func.dummy) },
			"dapplyCollect.ncol.10" = { dapplyCollect(data.df.ncol.10, func.dummy) },
			"dapplyCollect.ncol.100" = { dapplyCollect(data.df.ncol.100, func.dummy) },
			times = n
		)
	}
}

# gapply, nkey
run.mbm.gapply.nkey <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"gapply.nkey.10" = { gapply(data.df.nkey.10, data.df.nkey.10$key, gfunc.mean, schema(data.df.nkey.10)) %>% nrow },
			"gapply.nkey.100" = { gapply(data.df.nkey.100, data.df.nkey.100$key, gfunc.mean, schema(data.df.nkey.100)) %>% nrow },
			times = n
		)
	} else if (mode == "medium") {
		microbenchmark(
			"gapply.nkey.10" = { gapply(data.df.nkey.10, data.df.nkey.10$key, gfunc.mean, schema(data.df.nkey.10)) %>% nrow },
			"gapply.nkey.100" = { gapply(data.df.nkey.100, data.df.nkey.100$key, gfunc.mean, schema(data.df.nkey.100)) %>% nrow },
			"gapply.nkey.1k" = { gapply(data.df.nkey.1k, data.df.nkey.1k$key, gfunc.mean, schema(data.df.nkey.1k)) %>% nrow },
			times = n
		)
	} else {
		microbenchmark(
			"gapply.nkey.10" = { gapply(data.df.nkey.10, data.df.nkey.10$key, gfunc.mean, schema(data.df.nkey.10)) %>% nrow },
			"gapply.nkey.100" = { gapply(data.df.nkey.100, data.df.nkey.100$key, gfunc.mean, schema(data.df.nkey.100)) %>% nrow },
			"gapply.nkey.1k" = { gapply(data.df.nkey.1k, data.df.nkey.1k$key, gfunc.mean, schema(data.df.nkey.1k)) %>% nrow },
			times = n
		)
	}
}

# gapply, nrow
run.mbm.gapply.nrow <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"gapply.nrow.10" = { gapply(data.df.nrow.10, data.df.nrow.10$key, gfunc.mean, schema(data.df.nrow.10)) %>% nrow },
			"gapply.nrow.100" = { gapply(data.df.nrow.100, data.df.nrow.100$key, gfunc.mean, schema(data.df.nrow.100)) %>% nrow },
			times = n
		)
	} else if (mode == "medium") {
		microbenchmark(
			"gapply.nrow.10" = { gapply(data.df.nrow.10, data.df.nrow.10$key, gfunc.mean, schema(data.df.nrow.10)) %>% nrow },
			"gapply.nrow.100" = { gapply(data.df.nrow.100, data.df.nrow.100$key, gfunc.mean, schema(data.df.nrow.100)) %>% nrow },
			"gapply.nrow.1k" = { gapply(data.df.nrow.1k, data.df.nrow.1k$key, gfunc.mean, schema(data.df.nrow.1k)) %>% nrow },
			times = n
		)
	} else {
		microbenchmark(
			"gapply.nrow.10" = { gapply(data.df.nrow.10, data.df.nrow.10$key, gfunc.mean, schema(data.df.nrow.10)) %>% nrow },
			"gapply.nrow.100" = { gapply(data.df.nrow.100, data.df.nrow.100$key, gfunc.mean, schema(data.df.nrow.100)) %>% nrow },
			"gapply.nrow.1k" = { gapply(data.df.nrow.1k, data.df.nrow.1k$key, gfunc.mean, schema(data.df.nrow.1k)) %>% nrow },
			"gapply.nrow.10k" = { gapply(data.df.nrow.10k, data.df.nrow.10k$key, gfunc.mean, schema(data.df.nrow.10k)) %>% nrow },
			times = n
		)
	}

}

# gapply, keytype
run.mbm.gapply.keytype <- function(n) {
	microbenchmark(
		"gapply.keytype.int" = { gapply(data.df.keytype.int, data.df.keytype.int$key, gfunc.mean, schema(data.df.keytype.int)) %>% nrow },
		"gapply.keytype.char10" = { gapply(data.df.keytype.char10, data.df.keytype.char10$key, gfunc.mean, schema(data.df.keytype.char10)) %>% nrow },
		"gapply.keytype.char100" = { gapply(data.df.keytype.char100, data.df.keytype.char100$key, gfunc.mean, schema(data.df.keytype.char100)) %>% nrow },
		times = n
	)
}

# gapplyCollect, nkey
run.mbm.gapplyCollect.nkey <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"gapplyCollect.nkey.10" = { gapplyCollect(data.df.nkey.10, data.df.nkey.10$key, gfunc.mean) },
			"gapplyCollect.nkey.100" = { gapplyCollect(data.df.nkey.100, data.df.nkey.100$key, gfunc.mean) },
			times = n
		)
	} else if (mode == "medium") {
		microbenchmark(
			"gapplyCollect.nkey.10" = { gapplyCollect(data.df.nkey.10, data.df.nkey.10$key, gfunc.mean) },
			"gapplyCollect.nkey.100" = { gapplyCollect(data.df.nkey.100, data.df.nkey.100$key, gfunc.mean) },
			"gapplyCollect.nkey.1k" = { gapplyCollect(data.df.nkey.1k, data.df.nkey.1k$key, gfunc.mean) },
			times = n
		)
	} else {
		microbenchmark(
			"gapplyCollect.nkey.10" = { gapplyCollect(data.df.nkey.10, data.df.nkey.10$key, gfunc.mean) },
			"gapplyCollect.nkey.100" = { gapplyCollect(data.df.nkey.100, data.df.nkey.100$key, gfunc.mean) },
			"gapplyCollect.nkey.1k" = { gapplyCollect(data.df.nkey.1k, data.df.nkey.1k$key, gfunc.mean) },
			times = n
		)
	}
}

# gapplyCollect, nrow
run.mbm.gapplyCollect.nrow <- function(mode, n) {
	if (mode == "small") {
		microbenchmark(
			"gapplyCollect.nrow.10" = { gapplyCollect(data.df.nrow.10, data.df.nrow.10$key, gfunc.mean) },
			"gapplyCollect.nrow.100" = { gapplyCollect(data.df.nrow.100, data.df.nrow.100$key, gfunc.mean) },
			times = n
		)
	} else if (mode == "medium") {
		microbenchmark(
			"gapplyCollect.nrow.10" = { gapplyCollect(data.df.nrow.10, data.df.nrow.10$key, gfunc.mean) },
			"gapplyCollect.nrow.100" = { gapplyCollect(data.df.nrow.100, data.df.nrow.100$key, gfunc.mean) },
			"gapplyCollect.nrow.1k" = { gapplyCollect(data.df.nrow.1k, data.df.nrow.1k$key, gfunc.mean) },
			times = n
		)
	} else {
		microbenchmark(
			"gapplyCollect.nrow.10" = { gapplyCollect(data.df.nrow.10, data.df.nrow.10$key, gfunc.mean) },
			"gapplyCollect.nrow.100" = { gapplyCollect(data.df.nrow.100, data.df.nrow.100$key, gfunc.mean) },
			"gapplyCollect.nrow.1k" = { gapplyCollect(data.df.nrow.1k, data.df.nrow.1k$key, gfunc.mean) },
			"gapplyCollect.nrow.10k" = { gapplyCollect(data.df.nrow.10k, data.df.nrow.10k$key, gfunc.mean) },
			times = n
		)
	}
}

# gapplyCollect, keytype
run.mbm.gapplyCollect.keytype <- function(n) {
	microbenchmark(
		"gapplyCollect.keytype.int" = { gapplyCollect(data.df.keytype.int, data.df.keytype.int$key, gfunc.mean) },
		"gapplyCollect.keytype.char10" = { gapplyCollect(data.df.keytype.char10, data.df.keytype.char10$key, gfunc.mean) },
		"gapplyCollect.keytype.char100" = { gapplyCollect(data.df.keytype.char100, data.df.keytype.char100$key, gfunc.mean) },
		times = n
	)
}

# ============== compute object sizes ==================
ser <- function(data) {
	serialize(data, connection = NULL)
}
get.sizes <- function(obj_names, objs) {
	obj_sizes <- objs %>% lapply(ser) %>% lapply(object.size)
	data.frame(cbind(obj_names, obj_sizes))
}

# lapply
sizes.lapply.type <- get.sizes(
	list(
		"lapply.double.100",
		"lapply.int.100",
		"lapply.logical.100",
		"lapply.char1.100",
		"lapply.char10.100",
		"lapply.char100.100",
		"lapply.char1k.100"),
	list(
		data.list.type.double,
		data.list.type.int,
		data.list.type.logical,
		data.list.type.char1,
		data.list.type.char10,
		data.list.type.char100,
		data.list.type.char1k)
)
sizes.lapply.len <- get.sizes(
	list(
		"lapply.len.10",
		"lapply.len.100",
		"lapply.len.1k",
		"lapply.len.10k"),
	list(
		data.list.len.10,
		data.list.len.100,
		data.list.len.1k,
		data.list.len.10k)
)

# data for dapply
df.dapply.type <- lapply(list(
	data.list.type.double,
	data.list.type.int,
	data.list.type.logical,
	data.list.type.char1,
	data.list.type.char10,
	data.list.type.char100,
	data.list.type.char1k), data.frame)
df.dapply.len <- lapply(list(
		data.list.len.10,
		data.list.len.100,
		data.list.len.1k,
		data.list.len.10k), data.frame)
df.dapply.ncol <- lapply(list(
		data.list.len.100,
		rep(data.rdf.len.100, each = 10),
		rep(data.rdf.len.100, each = 100)), data.frame)

# dapply
sizes.dapply.type <- get.sizes(
	list(
		"dapply.double.100",
		"dapply.int.100",
		"dapply.logical.100",
		"dapply.char1.100",
		"dapply.char10.100",
		"dapply.char100.100",
		"dapply.char1k.100"),
	df.dapply.type
)
sizes.dapply.len <- get.sizes(
	list(
		"dapply.len.10",
		"dapply.len.100",
		"dapply.len.1k",
		"dapply.len.10k"),
	df.dapply.len
)
sizes.dapply.ncol <- get.sizes(
	list(
		"dapply.ncol.1",
		"dapply.ncol.10",
		"dapply.ncol.100"),
	df.dapply.ncol
)

# dapplyCollect
sizes.dapplyCollect.type <- get.sizes(
	list(
		"dapplyCollect.double.100",
		"dapplyCollect.int.100",
		"dapplyCollect.logical.100",
		"dapplyCollect.char1.100",
		"dapplyCollect.char10.100",
		"dapplyCollect.char100.100",
		"dapplyCollect.char1k.100"),
	df.dapply.type
)
sizes.dapplyCollect.len <- get.sizes(
	list(
		"dapplyCollect.len.10",
		"dapplyCollect.len.100",
		"dapplyCollect.len.1k",
		"dapplyCollect.len.10k"),
	df.dapply.len
)
sizes.dapplyCollect.ncol <- get.sizes(
	list(
		"dapplyCollect.ncol.1",
		"dapplyCollect.ncol.10",
		"dapplyCollect.ncol.100"),
	df.dapply.ncol
)

# data for gapply
df.gapply.nkey <- list(
	data.frame(key = rep(1:10, 100), val = data.rand.1k),
	data.frame(key = rep(1:100, 10), val = data.rand.1k),
	data.frame(key = 1:1000, val = data.rand.1k))
df.gapply.nrow <- list(
	data.frame(key = 1:10, val = runif(10)),
	data.frame(key = rep(1:10, 10), val = runif(100)),
	data.frame(key = rep(1:10, 100), val = data.rand.1k),
	data.frame(key = rep(1:10, 1000), val = runif(10000)))
df.gapply.keytype <- list(
	data.frame(key = rep(1:10, 100), val = data.rand.1k),
	data.frame(key = rep(key.char10, 100), val = data.rand.1k),
	data.frame(key = rep(key.char100, 10), val = data.rand.1k))

# gapply
sizes.gapply.nkey <- get.sizes(
	list(
		"gapply.nkey.10",
		"gapply.nkey.100",
		"gapply.nkey.1k"),
	df.gapply.nkey
)
sizes.gapply.nrow <- get.sizes(
	list(
		"gapply.nrow.10",
		"gapply.nrow.100",
		"gapply.nrow.1k",
		"gapply.nrow.10k"),
	df.gapply.nrow
)
sizes.gapply.keytype <- get.sizes(
	list(
		"gapply.keytype.int",
		"gapply.keytype.char10",
		"gapply.keytype.char100"),
	df.gapply.keytype
)

# gapplyCollect
sizes.gapplyCollect.nkey <- get.sizes(
	list(
		"gapplyCollect.nkey.10",
		"gapplyCollect.nkey.100",
		"gapplyCollect.nkey.1k"),
	df.gapply.nkey
)
sizes.gapplyCollect.nrow <- get.sizes(
	list(
		"gapplyCollect.nrow.10",
		"gapplyCollect.nrow.100",
		"gapplyCollect.nrow.1k",
		"gapplyCollect.nrow.10k"),
	df.gapply.nrow
)
sizes.gapplyCollect.keytype <- get.sizes(
	list(
		"gapplyCollect.keytype.int",
		"gapplyCollect.keytype.char10",
		"gapplyCollect.keytype.char100"),
	df.gapply.keytype
)

df.sizes <- rbind(
	sizes.lapply.type,
	sizes.lapply.len,
	sizes.dapply.type,
	sizes.dapply.len,
	sizes.dapply.ncol,
	sizes.dapplyCollect.type,
	sizes.dapplyCollect.len,
	sizes.dapplyCollect.ncol,
	sizes.gapply.nkey,
	sizes.gapply.nrow,
	sizes.gapply.keytype,
	sizes.gapplyCollect.nkey,
	sizes.gapplyCollect.nrow,
	sizes.gapplyCollect.keytype)
df.sizes$obj_names <- unlist(df.sizes$obj_names)
df.sizes$obj_sizes <- unlist(df.sizes$obj_sizes)


library(ggplot2)

x <- c(-2, -1, 0, 1, 2, 3, 4, 5)
y <- c(-64, -27.5, -9.3, -2.2, -0.5, 0.2, 7.1, 27)
plot(x,y)


mtcars[2:3:5, 1]
mtcars[1, 2]
mtcars[, am]
mtcars[[9]]
D$names[length(D$names)]


#author: Thomas Coleman
# Difference in Differences Regressions - Error Analysis and Graphs for data from Snow 1855

# See "Causality in the Time of Cholera" working paper at https://papers.ssrn.com/abstract=3262234
# and my John Snow project website, http://www.hilerun.org/econ/papers/snow

# This code is licensed under the BSD 2-Clause License, https://opensource.org/licenses/BSD-2-Clause

# This collect together some simple functions that produce a standard format graph, and are 'source'd
# into various notebooks

# **preperrdata** Before graphing, to prepare the data

#  * Takes in *fittedmodel* - a regression that has been already run. From this it extracts the necessary
#  parameters. Also *single*, a string which for "single" says that there is a single treatment effect.
#  * Calculates the 1849 and 1854 predicted counts and rates
#  * Calculates *approximate* 95% error bars around the predicted rates, based on whether the fitted model
#  is Poisson or Negative Binomial
#  * Produces an adjusted 1854 predicted rate, adjusting for the 1854 time effect and treatment effect, so
#  that it is comparable to the 1849 predicted rate (for purposes of plotting with error bars)

#  This function changes global data (the x1849 & x1854 dataframes) using the "<<-" instead of "<-"
#  assignment. This is poor programming style but I could not find another easy way of doing what I wanted.

# **plot2_worker** Plots actual vs predicted, with error bars around the predicted

#  * Actually does the plotting, given all the data as input arguments (sequence no. for sub-districts;
#  the actual mean or rate; predicted; the 2.5% and 97.5% points; title)
#  * btw, the hack for plotting error bars is from
#  https://stackoverflow.com/questions/13032777/scatter-plot-with-error-bars

# **plot2** Is a cover function which unpacks the actual versus predicted mean from the appropriate dataframe

# **plot3** Plots actual 1849, 1854 (adjusted for time & treatment effects), predicted, with error bars

# **plotcomp** Plots actual 1849 versus 1854, with error bars around actual 1849

# **ploterrbars** is NOT a function you should use - I use it to print out .pdf versions of the graphs I want to use

# 22-jul-2020 modify to create "adjusted rates" for both 1849 and 1854

preperrdata <- function(fittedmodel,single = "single",link="log",conf=.95,population="population") {       # This is not a good way to do this because I am
	                                                  # changing globals from within the function (using <<-
	                                                  # instead of <-)
# Function to prepare the data (error bars) for graphing
# The 2.5% and 97.5% confidence bands are calculated assuming either Poisson or Negative Binomial
# The rates are calculated by generating the counts up and down from the "expected" (from the fitted model)

	# Set the confidence levels (inputting 0.95 means lower leve .025, upper .975, total .05 / .95)
	xconfidl <- (1-conf)/2
	xconfidu <- 1-xconfidl
	expected <- predict(fittedmodel)
	xfamily <- family(fittedmodel)$family
	if (link == "log") {
		expected <- exp(expected)       # expected values
	}
	if (substr(xfamily,1,8) == "gaussian") {   # For OLS "rate" model need to convert from rates to counts
		expected[1:28] <- expected[1:28] * x1849[,population]
		expected[29:56] <- expected[29:56] * x1854[,population]
	}
	theta <- fittedmodel$theta
	x1849$predcount <<- expected[1:28]
	x1854$predcount <<- expected[29:56]
	x1849$predrate <<- 10000 * expected[1:28] / x1849[,population]
	x1854$predrate <<- 10000 * expected[29:56] / x1854[,population]
	if (xfamily == "poisson") {         # Get 95% confidence bands depending on model used (Poiss vs Neg Binom)
		x1849$limdn <<- 10000 * qpois(xconfidl,lambda=x1849$predcount) / x1849[,population]
		x1849$limup <<- 10000 * qpois(xconfidu,lambda=x1849$predcount) / x1849[,population]
		x1854$limdn <<- 10000 * qpois(xconfidl,lambda=x1854$predcount) / x1854[,population]
		x1854$limup <<- 10000 * qpois(xconfidu,lambda=x1854$predcount) / x1854[,population]
		x1849$limdnact <<- 10000 * qpois(xconfidl,lambda=x1849$deaths) / x1849[,population]
		x1849$limupact <<- 10000 * qpois(xconfidu,lambda=x1849$deaths) / x1849[,population]
	} else if (substr(xfamily,1,8) == "Negative"){
		x1849$limdn <<- 10000 * qnbinom(xconfidl,size=theta,mu=x1849$predcount) / x1849[,population]
		x1849$limup <<- 10000 * qnbinom(xconfidu,size=theta,mu=x1849$predcount) / x1849[,population]
		x1854$limdn <<- 10000 * qnbinom(xconfidl,size=theta,mu=x1854$predcount) / x1854[,population]
		x1854$limup <<- 10000 * qnbinom(xconfidu,size=theta,mu=x1854$predcount) / x1854[,population]
		x1849$limdnact <<- 10000 * qnbinom(xconfidl,size=theta,mu=x1849$deaths) / x1849[,population]
		x1849$limupact <<- 10000 * qnbinom(xconfidu,size=theta,mu=x1849$deaths) / x1849[,population]
	} else if (substr(xfamily,1,8) == "gaussian"){
		x3 <- predict(fittedmodel,interval="prediction")   # I think "confidence" is what I want and not "prediction"
		x1849$limdn <<- x3[1:28,2]
		x1849$limup <<- x3[1:28,3]
		x1854$limdn <<- x3[29:56,2]
		x1854$limup <<- x3[29:56,3]
		if (link == "log") {    # There is no "link" item for lm, so the only way I can tell if this model is run
		                      # in level or log form is to look at the predicted, and if it is negative presume it's in logs
			x1849$limdn <<- exp(x1849$limdn)
			x1849$limup <<- exp(x1849$limup)
			x1854$limdn <<- exp(x1854$limdn)
			x1854$limup <<- exp(x1854$limup)
		}
		x1849$limdn <<- 10000 * x1849$limdn
		x1849$limup <<- 10000 * x1849$limup
		x1854$limdn <<- 10000 * x1854$limdn
		x1854$limup <<- 10000 * x1854$limup
	}

	# Now adjust the 1854 predicted counts (and rates) for the time and treatment fixed effects -
	# effectively netting out the 1854 effect and making it 1849-equivalent
	# Adjust for the year effect only - this should make 1849 & 1854 comparable net of time effect
	if (link == "log") {
		xyr1854 <- (coef(fittedmodel)["year1854"])
		x49 <- exp(xyr1854)
		x54 <- exp(-xyr1854)
		x1849$rateadjyr <<- 10000 * (x1849$deaths*x49) / x1849[,population]
		x1854$rateadjyr <<- 10000 * (x1854$deaths*x54) / x1854[,population]
	} else {
		x49 <- (coef(fittedmodel)["year1854"])
		x54 <- -(coef(fittedmodel)["year1854"])
		x1849$rateadjyr <<- x1849$rate + x49
		x1854$rateadjyr <<- x1854$rate + x54
	}
	# Adjust the 1854 actual for the estimated Treatment Effect and the estimated Year Effect
	if (single == "single")  {   # model with single treatment effect
		xdegless <- (coef(fittedmodel)["supplierSouthwarkVauxhall_Lambeth:year1854"])
		xdegmore <- xdegless               # Make both treatment effects the same
		if (link == "log") {
			x49 <- x49 * exp((x1849$lambethdegree == "less_Lambeth")*xdegless)
			x49 <- x49 * exp((x1849$lambethdegree == "more_Lambeth")*xdegmore)
			x54 <- x54 * exp(-(x1854$lambethdegree == "less_Lambeth")*xdegless)
			x54 <- x54 * exp(-(x1854$lambethdegree == "more_Lambeth")*xdegmore)
			x1849$rateadj <<- 10000 * (x1849$deaths*x49) / x1849[,population]
			x1854$rateadj <<- 10000 * (x1854$deaths*x54) / x1854[,population]
		} else {
			x49 <- x49 + (x1849$lambethdegree == "less_Lambeth")*xdegless
			x54 <- x49 + (x1849$lambethdegree == "more_Lambeth")*xdegmore
			x54 <- x54 -(x1854$lambethdegree == "less_Lambeth")*xdegless
			x54 <- x54 -(x1854$lambethdegree == "more_Lambeth")*xdegmore
			x1849$rateadj <<- x1849$rate + x49
			x1854$rateadj <<- x1854$rate + x54
		}
	} else if (single == "two") {      # model with two treatment effects
		xdegless <- coef(fittedmodel)["lambethdegreeless_Lambeth:year1854"]
		xdegmore <- coef(fittedmodel)["lambethdegreemore_Lambeth:year1854"]
		if (link == "log") {
			x49 <- x49 * exp((x1849$lambethdegree == "less_Lambeth")*xdegless)
			x49 <- x49 * exp((x1849$lambethdegree == "more_Lambeth")*xdegmore)
			x54 <- x54 * exp(-(x1854$lambethdegree == "less_Lambeth")*xdegless)
			x54 <- x54 * exp(-(x1854$lambethdegree == "more_Lambeth")*xdegmore)
			x1849$rateadj <<- 10000 * (x1849$deaths*x49) / x1849[,population]
			x1854$rateadj <<- 10000 * (x1854$deaths*x54) / x1854[,population]
		} else {
			x49 <- x49 + (x1849$lambethdegree == "less_Lambeth")*xdegless
			x54 <- x49 + (x1849$lambethdegree == "more_Lambeth")*xdegmore
			x54 <- x54 -(x1854$lambethdegree == "less_Lambeth")*xdegless
			x54 <- x54 -(x1854$lambethdegree == "more_Lambeth")*xdegmore
			x1849$rateadj <<- x1849$rate + x49
			x1854$rateadj <<- x1854$rate + x54
		}
	} else { # model with continuous treatment (population proportions)
		xperc_lambeth54 <- coef(fittedmodel)["perc_lambeth54"]
		if (link == "log") {
			x49 <-  exp((x1849$perc_lambeth * xperc_lambeth54)) / x49
			x54 <- x54 * exp(-(x1854$perc_lambeth * xperc_lambeth54))
			x1849$rateadj <<- 10000 * (x1849$deaths*x49) / x1849[,population]
			x1854$rateadj <<- 10000 * (x1854$deaths*x54) / x1854[,population]
		} else {
			x49 <- (x1849$perc_lambeth * xperc_lambeth54) - x49
			x54 <- x54 -(x1854$perc_lambeth * xperc_lambeth54)
			x1849$rateadj <<- x1849$rate + x49
			x1854$rateadj <<- x1854$rate + x54
		}
	}

	return(xfamily)
}

# "Worker" function to plot mean, predicted, and error bars
plot2_worker <- function(yseq, xmean,xlimdn,xpred,xlimup,title,legposition="bottomright") {
	xplot <- plot(xmean, yseq,
	    xlim=range(c(xmean, xpred,xlimdn,xlimup)),
	    ylim=rev(range(yseq)), col="red",
	    main=title,xlab="Mortality rate actual (red filled) vs predicted (empty circle)",ylab="sub-district",
	    pch=19)
	lines(xpred, yseq, type="p",
	    xlim=range(c(xmean, xpred,xlimdn,xlimup)),
	    ylim=rev(range(yseq)),
	    pch=1)
	# horizontal error bars
	xplot <- arrows(xlimdn, yseq, xlimup, yseq, length=0.05, angle=90, code=3,lty=3)
# Ooops - this legend is not for "plot2" but for "plotcomp"
#	xplot <- legend(legposition, c("1849 red circle", "1854 blue triangle"), col = c(2, 4),
#       text.col = c("red","blue"), lty = c(0, 0), pch = c(19, 17),
#       merge = TRUE,bty="o",bg="white")    # The bty="o" should overwrite the background

	xplot
}
# "Cover" function that takes in the dataframe and unpacks
plot2 <- function(confidata,xsupplier,title,legposition="bottomright") {
	xmean <- subset(confidata,supplier==xsupplier)[,"rate"]
	xlimdn <- subset(confidata,supplier==xsupplier)[,"limdn"]
	xlimup <- subset(confidata,supplier==xsupplier)[,"limup"]
	xpred <- subset(confidata,supplier==xsupplier)[,"predrate"]
	yseq <- subset(confidata,supplier==xsupplier)[,"seq"]
#	xtitle <- paste(xsupplier,title)
	xplot <- plot2_worker(yseq,xmean,xlimdn,xpred,xlimup,title,legposition)
}

# 29-jul-20 Split out "plot3_worker"
plot3_worker <- function(yseq,xmean, xpred,xlimdn,xlimup,x1854adj,title,legposition="bottomright") {
	xplot <- plot(xmean, yseq,
	    xlim=range(c(xmean, xpred,xlimdn,xlimup,x1854adj)),
	    ylim=rev(range(yseq)), col="red",
	    main=title,xlab="Mortality per 10,000 population",ylab="sub-district",
	    pch=19)
	lines(xpred, yseq, type="p",
	    xlim=range(c(xmean, xpred,xlimdn,xlimup)),
	    ylim=rev(range(yseq)),
	    pch=1)
	lines(x1854adj, yseq, type="p",
	    xlim=range(c(xmean, xpred,xlimdn,xlimup)),
	    ylim=rev(range(yseq)), col="blue",
	    pch=17)

	# horizontal error bars
	xplot <- arrows(xlimdn, yseq, xlimup, yseq, length=0.05, angle=90, code=3,lty=3)
	xplot <- legend(legposition, c("1849 red circle", "1854 blue triangle", "predicted"), col = c(2, 4, 1),
       text.col = c("red","blue","black"), lty = c(0, 0, 3), pch = c(19, 17, 1),
       merge = TRUE,bty="o",bg="white")    # The bty="o" should overwrite the background
}

# 26-feb-20 add (optional) argument "rateadj" which can be set to either
#  - "rateadj" = 1854 rate adjusted for both year effect and treatment effect
#  - "rateadjyr" = 1854 adjusted only for year effect (not treaement effect)
# 22-jul-20 add (optional) argument "yearadj" which can be set to either 1849 or 1854
#  - "1849" - display base 1849, adjust 1854 back to 1849 by year effect and treatment
#  - "1854" - display base 1854, adjust 1849 forward to 1854by year (no adjustment) and treatment)
plot3 <- function(confidata1849,confidata1854,xsupplier,title,legposition="bottomright",rateadj="rateadj",yearadj="1849") {
	if (yearadj == "1849") {
		xmean <- subset(confidata1849,supplier==xsupplier)[,"rate"]
		xlimdn <- subset(confidata1849,supplier==xsupplier)[,"limdn"]
		xlimup <- subset(confidata1849,supplier==xsupplier)[,"limup"]
		xpred <- subset(confidata1849,supplier==xsupplier)[,"predrate"]
		yseq <- subset(confidata1849,supplier==xsupplier)[,"seq"]
		x1854adj <- subset(confidata1854,supplier==xsupplier)[,rateadj]
	}
	else {
		xmean <- subset(confidata1849,supplier==xsupplier)[,rateadj]
		xlimdn <- subset(confidata1854,supplier==xsupplier)[,"limdn"]
		xlimup <- subset(confidata1854,supplier==xsupplier)[,"limup"]
		xpred <- subset(confidata1854,supplier==xsupplier)[,"predrate"]
		yseq <- subset(confidata1854,supplier==xsupplier)[,"seq"]
		x1854adj <- subset(confidata1854,supplier==xsupplier)[,"rate"]
	}
	xplot <- plot3_worker(yseq,xmean, xpred,xlimdn,xlimup,x1854adj,title,legposition)
	# xplot <- plot(xmean, y,
	#     xlim=range(c(xmean, xpred,xlimdn,xlimup,x1854adj)),
	#     ylim=rev(range(y)), col="red",
	#     main=title,xlab="Mortality per 10,000 population",ylab="sub-district",
	#     pch=19)
	# lines(xpred, y, type="p",
	#     xlim=range(c(xmean, xpred,xlimdn,xlimup)),
	#     ylim=rev(range(y)),
	#     pch=1)
	# lines(x1854adj, y, type="p",
	#     xlim=range(c(xmean, xpred,xlimdn,xlimup)),
	#     ylim=rev(range(y)), col="blue",
	#     pch=17)

	# # horizontal error bars
	# xplot <- arrows(xlimdn, y, xlimup, y, length=0.05, angle=90, code=3,lty=3)
	# xplot <- legend(legposition, c("1849 red circle", "1854 blue triangle", "predicted"), col = c(2, 4, 1),
 #       text.col = c("red","blue","black"), lty = c(0, 0, 3), pch = c(19, 17, 1),
 #       merge = TRUE,bty="o",bg="white")    # The bty="o" should overwrite the background

}

# Plotting joint region for 1849 & 1854 with error bars for each
plotcomp <- function(confidata1849,confidata1854,xsupplier,title,legposition="bottomright") {
	xmean <- subset(confidata1849,supplier==xsupplier)[,"rate"]
	xlimdn <- subset(confidata1849,supplier==xsupplier)[,"limdnact"]
	xlimup <- subset(confidata1849,supplier==xsupplier)[,"limupact"]
	xpred <- subset(confidata1849,supplier==xsupplier)[,"predrate"]
	y <- subset(confidata1849,supplier==xsupplier)[,"seq"]
	xmean1854 <- subset(confidata1854,supplier==xsupplier)[,"rateadjyr"]
#	xlimdn1854 <- subset(confidata1854,supplier==xsupplier)[,"limdn"]
#	xlimup1854 <- subset(confidata1854,supplier==xsupplier)[,"limup"]
	xplot <- plot(xmean, y,
	    xlim=range(c(xmean, xmean1854,xlimdn,xlimup)),
	    ylim=rev(range(y)), col="red",
	    main=title,xlab="Mortality: 1849 red circle, 1854 blue diamond",ylab="sub-district",
	    pch=19)
	lines(xmean1854, y, type="p",
	    xlim=range(c(xmean, xmean1854,xlimdn,xlimup)),
	    ylim=rev(range(y)), col="blue",
	    pch=17)

	# horizontal error bars
	xplot <- arrows(xlimdn, y, xlimup, y, length=0.05, angle=90, code=3,,lty=3)
	xplot <- legend(legposition, c("1849 red circle", "1854 blue triangle"), col = c(2, 4),
       text.col = c("red","blue"), lty = c(0, 0), pch = c(19, 17),
       bty="o",bg="white")    # The bty="o" should overwrite the background

#	xplot <- arrows(xlimdn1854, y, xlimup1854, y, length=0.05, angle=90, code=3)
}

ploterrbars <- function(fittedmodel,plotname,single = "single") {       # This is not a good way to do this because I am
	                                                  # changing globals from within the function (using <<-
	                                                  # instead of <-)
	xfamily <- preperrdata(fittedmodel,single)  # this function modifies global data

	pdf(paste("../paper/figures/errbar_",plotname,"a.pdf",sep=""))
		plot2(x1849,"SouthwarkVauxhall",paste("First-12 Southwark-only ",xfamily," 1849 "))
	dev.off()
	pdf(paste("../paper/figures/errbar_",plotname,"b.pdf",sep=""))
		plot2(x1849,"SouthwarkVauxhall_Lambeth",paste("Next-16 Jointly-Supplied ",xfamily," 1849 "))
	dev.off()
	pdf(paste("../paper/figures/errbar_",plotname,"c.pdf",sep=""))
		plot3(x1849,x1854,"SouthwarkVauxhall",paste("First-12 Southwark-only ",xfamily," 1849vs1854 "))
	dev.off()
	pdf(paste("../paper/figures/errbar_",plotname,"d.pdf",sep=""))
		plot3(x1849,x1854,"SouthwarkVauxhall_Lambeth",paste("Next-16 Jointly-Supplied ",xfamily," 1849vs1854 "))
	dev.off()
	if (xfamily != "poisson") {         # Plot comparison for joint region only for Negative Binomial
		pdf(paste("../paper/figures/errbar_",plotname,"e.pdf",sep=""))
			plotcomp(x1849,x1854,"SouthwarkVauxhall",paste("First-12 Southwark-only ",xfamily," 1849vs1854 "))
		dev.off()
		pdf(paste("../paper/figures/errbar_",plotname,"f.pdf",sep=""))
			plotcomp(x1849,x1854,"SouthwarkVauxhall_Lambeth",paste("Next-16 Jointly-Supplied ",xfamily," 1849vs1854 "))
		dev.off()
	}

}


#' Title
#'
#' @param alpha
#' @param Y
#'
#' @return
#' @export
#'
#' @examples
MatrixPropagation<-function(Y,alpha=0.2)
{
    library(Matrix)

    #Physical network

    pos <- match(total_unique_Conn_Physical, total_unique[,2])
    #alpha = c(0.01,0.1,0.2,0.3,0.4,0.5,0.6)

    F <- Y
    F2 <- F[pos]
    memo<-F2
    l= 1
    memoL = matrix(c(1:20),ncol = 20)
    bol = 1

    while(bol)
    {
        WF = normPhysical %*% F2
        F2 = (alpha * WF) + (1 - alpha) * F[pos]
        l = length(c(1:length(total_unique_Conn_Physical))[total_unique_Conn_Physical[order(as.matrix(memo))]==total_unique_Conn_Physical[order(as.matrix(F2))]])
        memoL = c(memoL,l)
        bol = mean(memoL[c((length(memoL)-19):length(memoL))])!=l
        memo = F2
    }
    F[pos] <- F2

    resultatPhysical<-cbind(total_unique[order(F,decreasing=T),],F[order(F,decreasing=T)])

    #Functional network

    pos <- match(total_unique_Conn_Func, total_unique[,2])
    #alpha = c(0.01,0.1,0.2,0.3,0.4,0.5,0.6)

    F <- Y
    F2 <- F[pos]
    memo<-F2
    l= 1
    memoL = matrix(c(1:20),ncol = 20)
    bol = 1

    while(bol)
    {
        WF = normFunc %*% F2
        F2 = (alpha * WF) + (1 - alpha) * F[pos]
        l = length(c(1:length(total_unique_Conn_Func))[total_unique_Conn_Func[order(as.matrix(memo))]==total_unique_Conn_Func[order(as.matrix(F2))]])
        memoL = c(memoL,l)
        bol = mean(memoL[c((length(memoL)-19):length(memoL))])!=l
        memo = F2
    }
    F[pos] <- F2

    resultatFunctional<-cbind(total_unique[order(F,decreasing=T),],F[order(F,decreasing=T)])
    ClinPriorScore <- cbind(resultatFunctional,resultatPhysical)
    colnames(ClinPriorScore) <-c("Symbol", "geneID", "PriorFunct", "Symbol", "geneID", "PriorPhys")

    gc()
    return(ClinPriorScore)
}


require(reshape)
require(stringr)
require(cluster)
require(fastICA)
require(bit64)
require(dplyr)
require(fitdistrplus)
require(MASS)

source("network_helpers.R")
source("analysis_helpers.R")

PREF_CATEGORIES <- c("art","game", "health", "hobby","humor", "movie","music","science","sport")
USER_INFO_FILE_HEADERS <- c("twitter_uid","twitter_screenname","n_status","n_follower","n_friend","n_listed")

#################################################
######GET THE DATA###############################
#################################################

load("user_data.rdata")

##we can pull out a bunch of data from here now and go get the network data from Twitter.
##to do so, we run "../python/ego_net_extractor.py"

#Then, we go get the tie strengths using ../python/get_tie_strengths.py
###then run get_alter_connections.py to get  (use this later - when getting alter_connections)

##finally, i got the cosine similarity of the user's 2014 tweets using ../python/get_cosine_sim.py

##these should all probably be (easily) integrated into a single script at some point

##this is basic info output by get_tie_strengths on the user's 2014 tweets
user_2014_tweet_info <- fread("../data/tie_info/node_info.tsv")
setnames(user_2014_tweet_info,c("twitter_uid","tweets_in_2014","n_possible_ties","n_users_mentioned_2014","total_mentions_2014"))

##output of get_tie_strengths
all_ego_ties <- fread("../data/tie_info/tie_strength.tsv")
setnames(all_ego_ties,c("twitter_uid","alter_id","user_alter_2014","alter_user_2014","total_alter_tweets"))
##calculate min to determing strong v weak ties
all_ego_ties$min_str <- with(all_ego_ties,ifelse(user_alter_2014 < alter_user_2014, user_alter_2014, alter_user_2014))

##ties w/ >2 mutual interactions are strong
all_ego_ties$strength <- "w"
all_ego_ties$strength[all_ego_ties$min_str > 2] <- "s"

n_tie_data <- all_ego_ties[,list(strong_ties=sum(strength=='s'), weak_ties=sum(strength=='w'), n_ties=length(strength)),by='twitter_uid']

tie_user_data <- merge(user_data, user_2014_tweet_info, by="twitter_uid",all.y=T)
tie_user_data <- merge(tie_user_data,n_tie_data,by="twitter_uid",all.x=T)

##if the user didn't have any ties, change from NA to 0
tie_user_data$strong_ties[is.na(tie_user_data$strong_ties)] <- 0
tie_user_data$weak_ties[is.na(tie_user_data$weak_ties)] <- 0
tie_user_data$n_ties[is.na(tie_user_data$n_ties)] <- 0

##set user's "total preferences"
tie_user_data$total_pref <- with(tie_user_data,weak+strong)

##messed up sampling of the 0/0 nodes, have to remove a few.
#also get rid of people who weren't very active in 2014
tie_user_data <- tie_user_data[n_checkin >= 10,]
tie_user_data <- tie_user_data[tweets_in_2014 > 50]
tie_user_data <- tie_user_data[n_possible_ties > 0]
tie_user_data <- tie_user_data[n_follower < 5000]

##pretty good fits to negative binomial
plot(fitdist(tie_user_data$n_ties,'nbinom'))
plot(fitdist(tie_user_data$strong_ties,'nbinom'))
plot(fitdist(tie_user_data$weak_ties,'nbinom'))

##cosine similarity and other topical metrics on the pre 2014 data
topical_info <- fread("../data/cosine_sim.tsv")
setnames(topical_info, c("twitter_uid","cosine_sim","n_tweets_prior_2014",
                         "informational_tweet_count", "n_times_retweeted", "n_hashtags_used"))
##BLAH. N times retweeted fail - bug in the code.
tie_user_data <- merge(tie_user_data, topical_info, by="twitter_uid")
##get rid of users we don't have data for
tie_user_data <- tie_user_data[n_tweets_prior_2014 > 1]
##standardize our predictor variables
standardize <- function(x){ (x-mean(x))/(2*sd(x))}
tie_user_data$lc <- with(tie_user_data,standardize(log(n_checkin)))
tie_user_data$ltw <- with(tie_user_data,standardize(log(tweets_in_2014)))
tie_user_data$lfol <- with(tie_user_data,standardize(log(n_follower)))
tie_user_data$lment <- with(tie_user_data,standardize(log(total_mentions_2014)))
tie_user_data$total_pref_st <- with(tie_user_data,standardize(total_pref))
tie_user_data$strong_pref_st <- with(tie_user_data,standardize(strong))
tie_user_data$weak_pref_st <- with(tie_user_data,standardize(weak))
tie_user_data$listed_count_st <- with(tie_user_data,standardize(n_listed))
tie_user_data$cosine_sim_st <- standardize(tie_user_data$cosine_sim)
tie_user_data$info_tweet_st <- standardize(tie_user_data$informational_tweet_count/tie_user_data$n_tweets_prior_2014)
tie_user_data$ht_st <- standardize(tie_user_data$n_hashtags_used/tie_user_data$n_tweets_prior_2014)

###############HYPOTHESES TESTING##################################

theme_set(theme_bw(17))

total <- glm.nb(n_ties~ltw+lc+lment+cosine_sim_st+total_pref_st+info_tweet_st+ht_st, data = tie_user_data)
anova(total,update(total, .~.-info_tweet_st-ht_st-ltw))
total.best <- update(total, .~.-ht_st-ltw)
total_plot <- model_to_plot(total.best)  + scale_x_discrete(labels=rev(c(
  "Log(N Mentions in 2014)","Total Cult. Pref.", "Log(N Checkins)", "Proportion Info Content", "Cosine Similarity of Tweets")))
ggsave("total_res.png",total_plot,h=3,w=6)

weak <- update(total,weak_ties~.-total_pref_st+weak_pref_st+strong_pref_st)
anova(weak, update(weak, .~.-ht_st))
weak.best <- update(weak, .~.-ht_st)
summary(weak.best)
anova(weak.best, update(weak.best, .~.-strong_pref_st))
weak.best <- update(weak.best, .~.-strong_pref_st)
anova(weak.best, update(weak.best, .~.-info_tweet_st))
weak.best <- update(weak.best, .~.-info_tweet_st)
anova(weak.best, update(weak.best,.~.-lc))
weak.best <- update(weak.best,.~.-lc)
anova(weak.best, update(weak.best,.~.-ltw))
weak.best <- update(weak.best,.~.-ltw)
weak_plot <- model_to_plot(weak.best)  + scale_x_discrete(labels=rev(c(
  "Log(N Mentions in 2014)","Num. Weak Cult. Pref.", "Cosine Similarity of Tweets")))
ggsave("weak_res.png",weak_plot,h=3,w=6)

strong <- update(total,strong_ties~.-total_pref_st+weak_pref_st+strong_pref_st)
##remove ht
anova(strong, update(strong,.~.-strong_pref_st-weak_pref_st-lc-ht_st))
strong.best <-update(strong,.~.-strong_pref_st-weak_pref_st-lc-ht_st)
strong_plot <- model_to_plot(strong.best)  + scale_x_discrete(labels=rev(c("Log(N Mentions in 2014)",
                                                                           "Log(N Tweets in 2014)",
                                                                           "Proportion Info Content","Cosine Similarity of Tweets")))
ggsave("strong_res.png",strong_plot,h=3,w=6)

#Now I have to move some data along to get H1, H2
alter_connections <- fread("../data/alter_tie_strength.tsv")
setnames(alter_connections, c("twitter_uid","a1","a2","weight"))
alter_connections <- alter_connections[twitter_uid %in% tie_user_data$twitter_uid]
wt <- tie_user_data[, get_alter_net_stats(twitter_uid,all_ego_ties,alter_connections),by="twitter_uid"]
wtd <- merge(tie_user_data,wt,by="twitter_uid")

wtnb <- glm.nb(n_conn~ltw+lc+lment+cosine_sim_st+info_tweet_st+ht_st+strong_pref_st+weak_pref_st+offset(log(n_ties^2)), data = wtd[n_ties >1])
anova(wtnb, update(wtnb,.~.-lc-strong_pref_st-weak_pref_st-info_tweet_st-lment))
wtnb <- update(wtnb,.~.-lc-strong_pref_st-weak_pref_st-info_tweet_st-lment)

wtnb_plot <- model_to_plot(wtnb) + scale_x_discrete(labels=
                                                      rev(c("Cosine Similarity of Tweets",
                                                            "Hashtag Usage",
                                                            "Log(N Tweets in 2014)")))

ggsave("all_n_conn_res.png",wtnb_plot,h=3,w=6)

wt_cos_plot <- ggplot(tie_user_data[-1497], aes(weak,cosine_sim)) + stat_summary(fun.data="mean_cl_boot")  + stat_smooth(method='lm')  + ylab("Cosine Similarity") + xlab("Number of Weak Cultural Preferences")
ggsave("wt_cos_res.png",wt_cos_plot,h=4,w=7)

st_cos_plot <- ggplot(tie_user_data[-1497], aes(strong,cosine_sim)) + stat_summary(fun.data="mean_cl_boot")  + stat_smooth(method='lm')  + ylab("Cosine Similarity") + xlab("Number of Strong Cultural Preferences")
ggsave("st_cos_res.png",st_cos_plot,h=4,w=7)


## MA plot
## From Stephen Turner, @genetics_blog
##
maplot <- function (res, thresh=0.05, labelsig=TRUE, textcx=1, ...) {
  with(res, plot(baseMean, log2FoldChange, pch=20, cex=.5, log="x", ...))
  with(subset(res, padj<thresh), points(baseMean, log2FoldChange, col="red", pch=20, cex=1.5))
  if (labelsig) {
    require(calibrate)
    with(subset(res, padj<thresh), textxy(baseMean, log2FoldChange, labs=Gene, cex=textcx, col=2))
  }
}


# Transform data

# A. case_when()
# 1. Combine two variables
# Create skill variable with 3 levels
bakers_skill <- bakers %>%
  mutate(skill = case_when(
    star_baker > technical_winner ~ "super_star",
    star_baker < technical_winner ~ "high_tech",
    TRUE ~ "well_rounded"
  ))

# Filter zeroes to examine skill variable
bakers_skill %>%
  filter(star_baker == 0 & technical_winner == 0) %>%
  count(skill)

# 2. Add another bin
# Add pipe to drop skill = NA
bakers_skill <- bakers %>%
  mutate(skill = case_when(
    star_baker > technical_winner ~ "super_star",
    star_baker < technical_winner ~ "high_tech",
    star_baker == 0 & technical_winner == 0 ~ NA_character_,
    star_baker == technical_winner  ~ "well_rounded"
  )) %>%
  drop_na(skill)

# Count bakers by skill
bakers_skill %>%
  count(skill)

# B. Factors
# library(forcats)
# 1. Cast a factor and examine levels
# Cast skill as a factor
bakers <- bakers %>%
  mutate(skill = as.factor(skill))

# Examine levels
bakers %>%
  dplyr::pull(skill) %>%
  levels()

# 2. Plot factor counts
# Plot counts of bakers by skill, fill by winner
ggplot(bakers, aes(x = skill, fill = series_winner)) +
    geom_bar()

# Edit to reverse x-axis order
ggplot(bakers, aes(x = fct_rev(skill), fill = series_winner)) +
  geom_bar()

# C. Dates
# library(lubridate)
# 1. Cast characters as dates
# Add a line to extract labeled month
baker_dates_cast <- baker_dates %>%
  mutate(last_date_appeared_us = dmy(last_date_appeared_us),
         last_month_us = month(last_date_appeared_us, label = TRUE))

# Make bar chart by last month
ggplot(baker_dates_cast, aes(x = last_month_us)) +
  geom_bar()

# 2. Calculate timespans
# Add a line to create whole months on air variable
baker_time <- baker_time  %>%
  mutate(time_on_air = interval(first_date_appeared_uk, last_date_appeared_uk),
         weeks_on_air = time_on_air / weeks(1),
         months_on_air = time_on_air %/% months(1))

# D. Strings
# library(stringr)
# 1. Wrangle a character variable
# Add another mutate to replace "THIRD PLACE" with "RUNNER UP"and count
bakers <- bakers %>%
  mutate(position_reached = str_to_upper(position_reached),
         position_reached = str_replace(position_reached, "-", " "),
         position_reached = str_replace(position_reached, "THIRD PLACE", "RUNNER UP"))

# Count rows
bakers %>%
  count(position_reached)

# 2. Detect a string pattern
# Add a line to create new variable called student
bakers <- bakers %>%
    mutate(occupation = str_to_lower(occupation),
           student = str_detect(occupation, "student"))

# Find all students and examine occupations
bakers %>%
    filter(student) %>%
    select(baker, occupation, student)


#' Function to sort data according to ie output (following the ape tree structure)
#'
#' This function sorts extant and nodal values according the ape tree structure
#' @param data_nodes named vector of ancestral states
#' @return object with extant and nodal values sorted according to the ape tree structure
#' @export
ieObject<-function(tree,data_extants,data_nodes){

#Create general structure based on tree in ape format
            matrix=tree$edge
            phy.matrix=data.frame(tree$edge,tree$edge.length,data_extants[matrix[,2]],data_extants[matrix[,2]])
            names(phy.matrix)=c("node_anc","node_desc","BL","value_anc","value_desc")
#Add ancestors to value_desc
                  for(i in 1:length(names(data_nodes))){
                        phy.matrix$value_desc[which(phy.matrix$node_desc==names(data_nodes[i]))]<-data_nodes[[i]]
                  }
#Fill in value_anc
                  for(i in 1:length(names(data_nodes))){
                        phy.matrix$value_anc[which(phy.matrix$node_anc==names(data_nodes[i]))]<-data_nodes[[i]]
                  }
#Add rate and change
                  phy.matrix$rate<-(phy.matrix$value_desc-phy.matrix$value_anc)/sqrt(phy.matrix$BL)
                  phy.matrix$change<-(phy.matrix$value_desc-phy.matrix$value_anc)
#branching times of ancestral nodes
      times<-branching.times(tree)
      time_node_anc<-c()
      for (i in phy.matrix$node_anc){
      time_node_anc<-append(time_node_anc,times[which(names(times)==i)])}
      phy.matrix$time_node_anc<-time_node_anc

return(phy.matrix)
}


# this makes sure the model  always returns a number around 5
# num_unique_users and total_users_counted must be mapped to Streams attributes using the streamAttributes and
# rObjects parameters in the RScript operator
predictedCount<-(score(num_unique_users, total_users_counted)  + runif(1,0.1, 0.6))


library(dplyr)
library(readr)
library(tidyr)

# reading in the data
data_train <- read.csv('./data/raw/CompleteResponses.csv')
data_predict <- read.csv('./data/raw/SurveyIncomplete.csv')

  # values set as zero although these should be null
plot(data_predict$brand)
data_predict$brand <- NA
data_predict$brand <- as.numeric(data_predict$brand)

# creating a column to mark datasets
data_train$predict <- 0
data_predict$predict <- 1
data <- union(data_train, data_predict)

# Coding categorical variables as factors with right levels values
data$brand <- factor(data$brand, levels=c(0,1), labels=c('Acer', 'Sony'))
data$elevel <- factor(data$elevel, levels=c(0,1,2,3,4), labels = c(
    "Less than High Scool Degree",
    "High School Degree",
    "Some College",
    "4-Year College Degree",
    "Master's, Doctoral or Professional Degree"
    )
)
data$car <- factor(data$car, levels=seq(1,20), labels=c(
    "BMW",
    "Buick",
    "Cadillac",
    "Chevrolet",
    "Chrysler",
    "Dodge",
    "Ford",
    "Honda",
    "Hyundai",
    "Jeep",
    "Kia",
    "Lincoln",
    "Mazda",
    "Mercedes Benz",
    "Mitsubishi",
    "Nissan",
    "Ram",
    "Subaru",
    "Toyota",
    "None of the above"
    )
)
data$zipcode <- factor(data$zipcode, levels=seq(0,8), labels=c(
    "New England",
    "Mid-Atlantic",
    "East North Central",
    "West North Central",
    "South Atlantic",
    "East South Central",
    "West South Central",
    "Mountain",
    "Pacific"
))

write.csv(data, file='./data/clean/clean_train_predict.csv', row.names = FALSE)


#Forecast using multinomial-dirichlet fit.
#clear environment, source paths, packages and functions.
rm(list=ls())
source('paths.r')
source('NEFI_functions/dmulti_ddirch_forecast.r')

#set output path.----
output.path <- NEON_dmulti.ddirch_fcast_fg.path

#load model and NEON site predictors..----
mod <- readRDS(ted_ITS.prior_dmulti.ddirch_fg_JAGSfit)
mod <- mod$all.preds
dat <- readRDS(hierarch_filled.path) #NEON site predictors.

#get core-level covariate means and sd.----
core_mu <- dat$core.core.mu
plot_mu <- dat$plot.plot.mu
site_mu <- dat$site.site.mu

#merge together.
plot_mu$siteID <- NULL
core.preds <- merge(core_mu   , plot_mu)
core.preds <- merge(core.preds, site_mu)
core.preds$relEM <- NULL
names(core.preds)[names(core.preds)=="b.relEM"] <- "relEM"

#get core-level SD.
core_sd <- dat$core.core.sd
plot_sd <- dat$plot.plot.sd
site_sd <- dat$site.site.sd
#merge together.
plot_sd$siteID <- NULL
core.sd <- merge(core_sd   , plot_sd)
core.sd <- merge(core.sd, site_sd)
core.sd$relEM <- NULL
names(core.sd)[names(core.sd)=="b.relEM"] <- "relEM"

#get plot-level covariate means and sd.----
core_mu <- dat$core.plot.mu
plot_mu <- dat$plot.plot.mu
site_mu <- dat$site.site.mu
#merge together, .
plot_mu$siteID <- NULL
plot.preds <- merge(core_mu,plot_mu)
plot.preds <- merge(plot.preds,site_mu)
plot.preds$relEM <- NULL
names(plot.preds)[names(plot.preds)=="b.relEM"] <- "relEM"

#get plot-level SD.
core_sd <- dat$core.plot.sd
plot_sd <- dat$plot.plot.sd
site_sd <- dat$site.site.sd
#merge together
plot_sd$siteID <- NULL
plot.sd <- merge(core_sd,plot_sd)
plot.sd <- merge(plot.sd,site_sd)
plot.sd$relEM <- NULL
names(plot.sd)[names(plot.sd)=='b.relEM'] <- "relEM"

#get site-level covariate means and sd.----
core_mu <- dat$core.site.mu
plot_mu <- dat$plot.site.mu
site_mu <- dat$site.site.mu
#merge together
site.preds <- merge(core_mu, plot_mu)
site.preds <- merge(site.preds,site_mu)
names(site.preds)[names(site.preds)=='b.relEM'] <- "relEM"

#get site-level SD.
core_sd <- dat$core.site.sd
plot_sd <- dat$plot.site.sd
site_sd <- dat$site.site.sd
#merge together.
site.sd <- merge(core_sd,plot_sd)
site.sd <- merge(site.sd,site_sd)
names(site.sd)[names(site.sd)=='b.relEM'] <- "relEM"

#run forecast.----
core.fit <- dmulti_ddirch_forecast(mod, cov_mu = core.preds, cov_sd = core.sd, names = core.preds$sampleID)
plot.fit <- dmulti_ddirch_forecast(mod, cov_mu = plot.preds, cov_sd = plot.sd, names = plot.preds$plotID)
site.fit <- dmulti_ddirch_forecast(mod, cov_mu = site.preds, cov_sd = site.sd, names = site.preds$siteID)

#testing function for errors
test_it <- F
if(test_it == T){
  mod=mod
  cov_mu = core.preds
  cov_sd = core.sd
  names = core.preds$sampleID
  seq.depth = 2000
  n.samp = 2
  zero_parameter_uncertainty=F
  zero_process_uncertainty = F
  zero_covariate_uncertainty=F
}

#store output as a list and save.----
output <- list(core.fit,plot.fit,site.fit,core.preds,plot.preds,site.preds,core.sd,plot.sd,site.sd)
names(output) <- c('core.fit','plot.fit','site.fit',
                   'core.preds','plot.preds','site.preds',
                   'core.sd','plot.sd','site.sd')
saveRDS(output, output.path)

#end script.----


# *****************************************************************
# *************** Population Dynamics Modeling ********************
# ******************* UTR Lake Sturgeon ***************************
# ****************** Author: Dan Walker ***************************
# ****************** Began on 27/06/2017 **************************
# *****************************************************************

# FINAL CODE - see popdy_scratch for development and testing

setwd("C:/Users/danwa/OneDrive/Research/Lake Sturgeon/Chapter3/LST Data/LST ABundance")
set.seed(865)

# Data from RMark POPAN Jolly-Seber MLE solution:
# Total UTR population in 2011: 5643
# Weight class - above/below 2500 g
# Length class - <650 mm TL, 650 - 950 mm TL, >950 mm TL
# Phi(survival) for heavy.avg.length = ~100%
# Phi for skinny, average length = 0.42 (0.15 - 0.75 95% CI)

# Annual releases
release = read.csv("UTR.yearly.release.csv")
plot(release)
summary(release) # releases ~ N(8862, 3616.236^2)
# 124,069 fish released 2000-2013

# 20 year classes >15 y.o. (SLSWG) = stock until 2035
addtl.releases = 22

sim.releases = as.integer(rnorm(addtl.releases, 8862, 3616.236))
year = 2014:2035
sim.releases.df = data.frame(year, sim.releases)
colnames(sim.releases.df) = c("Year", "count.released")
full.sim.release = rbind(release, sim.releases.df)

full.sim.release[15,2]= 14615
full.sim.release[16,2]= 16308

# ************************************************************
# end of data entry necessary for Simulation procedures
# ************************************************************

write.csv(full.sim.release, "full.sim.release.csv")

plot(full.sim.release,
     pch = ifelse(full.sim.release$Year >= 2016, 1, 16))
title(main = "Number of Reintroduced Lake Sturgeon")

mean(full.sim.release$count.released) # 9,163 fish released per year on average
sum(full.sim.release$count.released) # 329,872 fish released total

# Catch data
library(readxl)
catch = read_excel("CaptureData2.xlsx", sheet = 3)
View(catch)
l_a = na.omit(data.frame(catch$TL.mm, catch$Age.caught))
colnames(l_a)<-c("TL", "Age")
View(l_a)

boxplot(TL~Age, data = l_a)
plot(TL~Age, data = l_a)
title(main = "Lake Sturgeon Length at Age")

# fit a cubic polynomial to the data NEEDS WORK
l_a_cube = lm(TL~poly(Age, 3), data = l_a)
summary(l_a_cube)

lm.test = data.frame(l_a$Age)
pred.cubic = predict(l_a_cube, x = lm.test, interval = 'confidence', level = 0.99)

plot(TL~Age, data = l_a)
title(main = "Lake Sturgeon Length at Age")
abline(l_a_cube)

lines(pred.cubic[, 1], col = "black", lwd = 3)

cubic = function(x){
  781.7 + 1047.7*(x) + 123.6*(x^2) - 445.9*(x^3)
}
x = l_a$Age

y = cubic(x)

plot(x, y)

# VB growth curve

# *************************************************
# ****************** PopDy ************************
# *************************************************

# initialize storage matrix, constants
sim.mat = matrix(nrow = 1000, ncol = 36)
S.full = as.vector(seq(from = 0.15, to = 0.75, by = 0.01))
Z.full = -log(S.full) #remove step if Z's are changed
i = seq(from = 1 , to = 1000, by = 1000)
m = matrix(0, nrow = 36, ncol = 36)
# m
stock.numbers = full.sim.release[ ,2]
diag(m)<- stock.numbers
m[upper.tri(m)]<- NA #upper triangular matrix = NA, lower = 0, diag = stocking #s

# *************************************************
# *************** Simulation  *********************
# *************************************************
setwd("C:/Users/danwa/OneDrive/Research/Lake Sturgeon/Chapter3/LST Data/LST ABundance")
set.seed(865)
release = read.csv("UTR.yearly.release.csv")

# Necessary functions:
# 1
fish.at.age = function(x){

  non.na.index = as.integer(min(which(!is.na(x$N)))) #find first year of stocking

  if(non.na.index < 36){
    x$t = x$t - non.na.index #adjust t to reflect first year
    x = x[complete.cases(x), ] #remove NAs
    for(d in 1:(nrow(x)-1)){
      x$N[d+1] = round(x$N[d]*exp((-x$Z[d]*x$t[d+1])))
    }
  } else {
    x$N = as.integer(rnorm(1, 8862, 3616.236))
    }
    return(x)
}

# 2
na.pad = function(x, lent){
  x[1:lent]
}

# 3
rotate = function(x){
  t(apply(x, 2, rev))
}

# Simulation - fixed N0, variable Z
# initialize storage matrix, constants
sim.mat = matrix(nrow = 1000, ncol = 36)
S.full = as.vector(seq(from = 0.15, to = 0.75, by = 0.01))
Z.full = -log(S.full) #remove step if Z's are changed
i = seq(from = 1, to = 1000, by = 1)
m = matrix(0, nrow = 36, ncol = 36)
# m
stock.numbers = full.sim.release[ ,2]
diag(m)<- stock.numbers
m[upper.tri(m)]<- NA #upper triangular matrix = NA, lower = 0, diag = stocking #s

for(i in 1:1000){ #iterate 1000x simulations

  single.sim.result = matrix(NA, nrow = 36, ncol = 36) # initialize storage dataframe for output
  lent = 36

  for(n in 1:ncol(m)){ #iterate over all columns

    test.col = m[ , n]
    N = as.integer(test.col)
    df = as.data.frame(N)
    df$Z = sample(Z.full, 36) #tweak value here to lower mortality rate
    df$t = seq(from = 1, to = 36, by = 1)
    x = df

    if(n <= 35){
      x1 = fish.at.age(x)
      x1.exp = as.vector(na.pad(x1$N, lent))
      single.sim.result[ , n] = x1.exp
    } else {
      x$N[36] = as.integer(rnorm(1, 8862, 3616.236))
      x$N[1] <- x$N[36]
      x$N[36] <- NA
      single.sim.result[ , n] = x$N
    }
  }

  rott = rotate(single.sim.result)
  sim.resul = diag(rott)
  sim.resul.t = t(sim.resul)

  sim.mat[i, ] = sim.resul.t

}

View(sim.mat)

write.csv(sim.mat, "Fixed_N0_Varying_Z.csv")

# **********************************************************
# ************ first complete run 20/07/2017 ***************
# **********************************************************
# **********************************************************

# RESET ENVIRONMENT BEFORE RUNNING SECOND SIM!!!

# **********************************************************
# Simulation with fixed N0, fixed Z
# **********************************************************
setwd("C:/Users/danwa/OneDrive/Research/Lake Sturgeon/Chapter3/LST Data/LST ABundance")
set.seed(865)
release = read.csv("UTR.yearly.release.csv")

# New central function:

fish.age.fixedZ = function(x){

  if(non.na.index < 36){
    x = x[complete.cases(x), ] #remove NAs
    for(d in 1:(nrow(x)-1)){
      x$N[d+1] = round(x$N[d]*exp((-x$Z[d]*x$t[d+1])))
    }
    # N.export = as.vector(x$N)
    return(x)
  }
  else {
    x$N = as.integer(rnorm(1, 8862, 3616.236))
  }
}
# 2
na.pad = function(x, lent){
  x[1:lent]
}

# 3
rotate = function(x){
  t(apply(x, 2, rev))
}

# initialize storage matrix, constants
sim.mat = matrix(nrow = 1000, ncol = 36)
S.full = as.vector(seq(from = 0.15, to = 0.75, by = 0.01))
Z.full = -log(S.full) #remove step if Z's are changed
i = seq(from = 1, to = 1000, by = 1)
m = matrix(0, nrow = 36, ncol = 36)
# m
stock.numbers = full.sim.release[ ,2]
diag(m)<- stock.numbers
m[upper.tri(m)]<- NA #upper triangular matrix = NA, lower = 0, diag = stocking #s

for(i in 1:1000){ #iterate 1000x simulations

  single.sim.result = matrix(NA, nrow = 36, ncol = 36) # initialize storage dataframe for output
  lent = 36

  for(n in 1:ncol(m)){ #iterate over all columns

    test.col = m[ , n]
    N = as.integer(test.col)
    df = as.data.frame(N)
    df$t = seq(from = 1, to = 36, by = 1)
    x = df
    non.na.index = as.integer(min(which(!is.na(x$N)))) #find first year of stocking
    x$t = x$t - non.na.index #adjust t to reflect first year
    if(n < 36){
      x = x[complete.cases(x), ]
    }
    x$Z = ifelse(x$t <= 3, -log(0.75), -log(0.99))

    if(n <= 35){
      x1 = fish.age.fixedZ(x)
      x1.exp = as.vector(na.pad(x1$N, lent))
      single.sim.result[ , n] = x1.exp
    } else {
      x$N[36] = as.integer(rnorm(1, 8862, 3616.236))
      x$N[1] <- x$N[36]
      x$N[36] <- NA
      single.sim.result[ , n] = x$N
    }

  }

  rott = rotate(single.sim.result)
  sim.resul = diag(rott)
  sim.resul.t = t(sim.resul)

  sim.mat[i, ] = sim.resul.t

}

View(sim.mat)
write.csv(sim.mat, file = "Fixed_Z_Fixed_N0.csv")

# *************************************************************
# simulation with varying N0, fixed Z
# *************************************************************
setwd("C:/Users/danwa/OneDrive/Research/Lake Sturgeon/Chapter3/LST Data/LST ABundance")
set.seed(865)
release = read.csv("UTR.yearly.release.csv")

fish.age.fixedZ = function(x){

  if(non.na.index < 36){
    x = x[complete.cases(x), ] #remove NAs
    for(d in 1:(nrow(x)-1)){
      x$N[d+1] = round(x$N[d]*exp((-x$Z[d]*x$t[d+1])))
    }
    # N.export = as.vector(x$N)
    return(x)
  }
  else {
    x$N = as.integer(rnorm(1, 8862, 3616.236))
  }
}
# 2
na.pad = function(x, lent){
  x[1:lent]
}

# 3
rotate = function(x){
  t(apply(x, 2, rev))
}

sim.mat = matrix(nrow = 1000, ncol = 36)
addtl.releases = 22
for(j in 1:1000){
  # create new simulated release numbers
  sim.releases = as.integer(rnorm(addtl.releases, 8862, 3616.236))
  year = 2014:2035
  sim.releases.df = data.frame(year, sim.releases)
  colnames(sim.releases.df) = c("Year", "count.released")
  sim.releases.df = rbind(release, sim.releases.df)

  sim.releases.df[15,2]= 14615
  sim.releases.df[16,2]= 16308

  m = matrix(0, nrow = 36, ncol = 36)
  stock.numbers = sim.releases.df[ ,2]
  diag(m)<- stock.numbers
  m[upper.tri(m)]<- NA #upper triangular matrix = NA, lower = 0, diag = stocking #s

  single.sim.result = matrix(NA, nrow = 36, ncol = 36) # initialize storage dataframe for output
  lent = 36

  for(n in 1:ncol(m)){ #iterate over all columns

    test.col = m[ , n]
    N = as.integer(test.col)
    df = as.data.frame(N)
    df$t = seq(from = 1, to = 36, by = 1)
    x = df
    non.na.index = as.integer(min(which(!is.na(x$N)))) #find first year of stocking
    x$t = x$t - non.na.index #adjust t to reflect first year
    if(n < 36){
      x = x[complete.cases(x), ]
    }
    x$Z = ifelse(x$t <= 3, -log(0.75), -log(0.99))

    if(n <= 35){
      x1 = fish.age.fixedZ(x)
      x1.exp = as.vector(na.pad(x1$N, lent))
      single.sim.result[ , n] = x1.exp
    } else {
      x$N[36] = as.integer(rnorm(1, 8862, 3616.236))
      x$N[1] <- x$N[36]
      x$N[36] <- NA
      single.sim.result[ , n] = x$N
    }

  }

  rott = rotate(single.sim.result)
  sim.resul = diag(rott)
  sim.resul.t = t(sim.resul)

  sim.mat[j, ] = sim.resul.t

}
View(sim.mat)
sim.mat[sim.mat<0] <- 0
write.csv(sim.mat, file = "Fixed_Z_Varying_N0.csv")

# *************************************************************
# simulation with varying N0, fixed Z, doubled reintroductions
# *************************************************************
setwd("C:/Users/danwa/OneDrive/Research/Lake Sturgeon/Chapter3/LST Data/LST ABundance")
set.seed(865)
release = read.csv("UTR.yearly.release.csv")

fish.age.fixedZ = function(x){

  if(non.na.index < 36){
    x = x[complete.cases(x), ] #remove NAs
    for(d in 1:(nrow(x)-1)){
      x$N[d+1] = round(x$N[d]*exp((-x$Z[d]*x$t[d+1])))
    }
    # N.export = as.vector(x$N)
    return(x)
  }
  else {
    x$N = as.integer(rnorm(1, (2*8862), 3616.236))
  }
}
# 2
na.pad = function(x, lent){
  x[1:lent]
}

# 3
rotate = function(x){
  t(apply(x, 2, rev))
}

sim.mat = matrix(nrow = 1000, ncol = 36)
addtl.releases = 22
for(j in 1:1000){
  # create new simulated release numbers
  sim.releases = as.integer(rnorm(addtl.releases, (8862*2), 3616.236))
  year = 2014:2035
  sim.releases.df = data.frame(year, sim.releases)
  colnames(sim.releases.df) = c("Year", "count.released")
  sim.releases.df = rbind(release, sim.releases.df)

  sim.releases.df[15,2]= 14615
  sim.releases.df[16,2]= 16308

  m = matrix(0, nrow = 36, ncol = 36)
  stock.numbers = sim.releases.df[ ,2]
  diag(m)<- stock.numbers
  m[upper.tri(m)]<- NA #upper triangular matrix = NA, lower = 0, diag = stocking #s

  single.sim.result = matrix(NA, nrow = 36, ncol = 36) # initialize storage dataframe for output
  lent = 36

  for(n in 1:ncol(m)){ #iterate over all columns

    test.col = m[ , n]
    N = as.integer(test.col)
    df = as.data.frame(N)
    df$t = seq(from = 1, to = 36, by = 1)
    x = df
    non.na.index = as.integer(min(which(!is.na(x$N)))) #find first year of stocking
    x$t = x$t - non.na.index #adjust t to reflect first year
    if(n < 36){
      x = x[complete.cases(x), ]
    }
    x$Z = ifelse(x$t <= 3, -log(0.75), -log(0.99))

    if(n <= 35){
      x1 = fish.age.fixedZ(x)
      x1.exp = as.vector(na.pad(x1$N, lent))
      single.sim.result[ , n] = x1.exp
    } else {
      x$N[36] = as.integer(rnorm(1, 8862, 3616.236))
      x$N[1] <- x$N[36]
      x$N[36] <- NA
      single.sim.result[ , n] = x$N
    }

  }

  rott = rotate(single.sim.result)
  sim.resul = diag(rott)
  sim.resul.t = t(sim.resul)

  sim.mat[j, ] = sim.resul.t

}
View(sim.mat)
sim.mat[sim.mat<0] <- 0
write.csv(sim.mat, file = "Fixed_Z_Varying_N0_2xReintro.csv")


# Importing necessary libraries.
library(dplyr)
library(tidyr)
warning(FALSE)

# Reading test and train data.
test_x <- read.table('./DataSet/test/X_test.txt',header = FALSE)
test_y <- read.table('./DataSet/test/y_test.txt', header = FALSE)
train_x <- read.table('./DataSet/train/X_train.txt', header = FALSE)
train_y <- read.table('./DataSet/train/y_train.txt', header = FALSE)

# Looking into data.
head(test_x)
head(test_y)
head(train_x)
head(train_y)

# Checking the dimension of the data.
dim(test_x)
dim(test_y)
dim(train_x)
dim(train_y)

# Renaming the columns of the data.
col <- read.table('./DataSet/features.txt',header = FALSE)
names(train_x) <- col$V2
names(test_x) <- col$V2

subject_test <- read.table('DataSet/test/subject_test.txt',header = FALSE)
subject_train <- read.table('DataSet/train/subject_train.txt',header = FALSE)

# Checking if the columns has been changed or not.
print(names(test_x))
print(names(train_x))

test_x$activity <- test_y$V1
train_x$activity <- train_y$V1
test_x$subject_number <- subject_test$V1
train_x$subject_number <- subject_train$V1

head(test_x)

head(train_x)

df <- rbind(test_x,train_x)

head(df)

names(df) <- tolower(names(df))

mean_index <- grep(pattern = ".*mean\\(\\).*",names(df))
std_index <- grep(".*std\\(\\).*",names(df))

index <- c()
index <- append(index,mean_index)
index <- append(index,std_index)
index <- append(index,NCOL(df))
index <- append(index,NCOL(df)-1)
print(index)

df <- df[,index]
# head(df)
dim(df)

print(names(df))
print(length(index))

label <- read.table('DataSet/activity_labels.txt')

for(i in 1:NROW(df)){
  if(df[i,NCOL(df)] == 1) df[i,NCOL(df)] <- "WALKING"
  else if(df[i,NCOL(df)] == 2) df[i,NCOL(df)] <- "WALKING_UPSTAIRS"
  else if(df[i,NCOL(df)] == 3) df[i,NCOL(df)] <- "WALKING_DOWNSTAIRS"
  else if(df[i,NCOL(df)] == 4) df[i,NCOL(df)] <- "SITTING"
  else if(df[i,NCOL(df)] == 5) df[i,NCOL(df)] <- "STANDING"
  else if(df[i,NCOL(df)] == 6) df[i,NCOL(df)] <- "LAYING"
}

# Converting columns data type from string to floating point
for(i in 1:(ncol(df)-1)){
  df[,i] <- as.double(df[,i])
}
mean_df <- data.frame()

for(i in 1:30){
  for(j in label$V2){
    mean_df <- rbind(mean_df,(apply(df[(df$subject_number == i & df$activity == j),1:(ncol(df)-2)],2,mean)))
  }
}
label$V1 <- NULL
names(mean_df) <- names(df)[1:(ncol(df)-2)]
mean_df <- cbind(mean_df,merge(label,1:30))
mean_df <- rename(mean_df,'activity'='V2')
mean_df <- rename(mean_df,'subject_number'='y')
write.table(file = './mean_df.txt',x = mean_df,row.name=FALSE)

Getting and Cleaning Data/Final Assignment/run_analysis.r


set.seed(21512)
x <- raphylo(20)

x$tip.annotation[] <- rep(c(0,1), 10)
expect_equal(balance_ann(x), 1)

x$tip.annotation[] <- rep(0, 20)
expect_equal(balance_ann(x), 0)

x$tip.annotation[] <- rep(1, 20)
expect_equal(balance_ann(x), 0)

expect_error(balance_ann(x$tree))


library(pROC)
library(cowplot)

fn.poB = file.path(PROJECT_DIR, "generated_data", "CHI", "flow_percent_of_B_filtered.txt")
flow.poB = fread(fn.poB) %>% tibble::column_to_rownames("sample") %>%
  data.matrix()

fn.info = file.path(PROJECT_DIR, "generated_data", "CHI", "flow_sample_info_filtered.txt")
flow.info = fread(fn.info) %>%
  mutate(subject = as.character(subject))

fn.titer = file.path(PROJECT_DIR, "data", "CHI", "phenotypes", "titer_processed.txt")
df.titer = fread(fn.titer) %>%
  mutate(Subject = as.character(Subject)) %>%
  mutate(Response = ifelse(adjMFC_class==0, "low",
                           ifelse(adjMFC_class==2, "high", "middle")))

df = flow.info %>% add_column(CD38hi=flow.poB[,"Gate3"]) %>%
  left_join(df.titer, by=c("subject"="Subject")) %>%
  dplyr::filter(Response %in% c("low","high"),
         time %in% c(-7,0,70)) %>%
  mutate(Response = factor(Response,levels=c("low","high"))) %>%
  mutate(time.point = case_when(
                        time == 0 ~ "Baseline 1 (day 0)",
                        time == -7 ~ "Baseline 2 (day -7)",
                        time == 70 ~ "Baseline 3 (day 70)"
                      ) %>% factor())

# saveRDS(df, "flow_data_new.rds")

# generate Boxplots
df.w = df %>%
  dplyr::select(time.point, CD38hi, Response) %>%
  group_by(time.point) %>%
  dplyr::summarise(w.pv = ifelse(all(is.na(CD38hi)), NA,
    wilcox.test(CD38hi[Response=="high"], CD38hi[Response=="low"], exact=F, alternative = "greater")$p.value)) %>%
  mutate(lbl = sprintf("p = %.2g",w.pv)) %>%
  ungroup()

p1 = ggplot(df, aes(x=Response, y=CD38hi, group=Response)) +
  geom_boxplot(aes(fill=time.point), alpha=1, outlier.colour = NA) +
  geom_dotplot(binaxis = "y", stackdir = "center", aes(fill=Response)) +
  facet_wrap(~time.point, nrow=1) +
  scale_fill_manual(values=c("grey70", "grey90","grey50", "black", "white"), name="Response",
                    breaks=c(0,2), labels=c("low","high")) +
  geom_text(data = df.w, aes(label=lbl), x=1.5,y=Inf,vjust=1.1, hjust=0.5, size=4, inherit.aes = F) +
  xlab("Response") + ylab("CD38++ cells (% of alive B cells)") +
  coord_cartesian(xlim=c(0.8, 2.2)) +
  theme_bw() + theme(legend.position="none") +
  theme(panel.border = element_blank(), strip.background = element_blank(),
        strip.text.x = element_text(size=12),
        panel.spacing = unit(0,"mm"), panel.grid.major.x = element_blank(),
        axis.ticks = element_blank())

# Generate ROC plots
roc.df = data.frame()
df.text = data.frame()
N_perm = 1000
for (tp in c(0,-7,70)) {
  r = roc(Response~CD38hi, data=dplyr::filter(df,time==tp), direction="<", quiet = T)
  set.seed(123)
  r.null = vector("numeric", N_perm)
  for(i in 1:N_perm) {
    # iperm = sample(nrow(df))
    r.null[i] = roc(Response~sample(CD38hi), data=dplyr::filter(df,time==tp), direction="<", quiet = T)$auc
  }
  r.p = sum(r.null > r$auc) / N_perm
  r.df = data.frame(day=paste0("day ",tp), Specificity = r$specificities, Sensitivity=r$sensitivities) %>%
    arrange(Sensitivity)
  roc.df = rbind(roc.df, r.df)

  df.text = rbind(df.text,
                  data.frame(day=paste0("day ",tp), label=sprintf("AUC = %.2f\np = %.2g",r$auc,r.p)))
}
df.text$x = rep(0.25,3)
df.text$y = rep(0.1,3)
df.text = df.text %>%
  mutate(day = factor(day, levels=levels(roc.df$day)))

p2 = list()
for(tm in levels(df.text$day)) {
  p2[[tm]] = ggplot(roc.df %>% dplyr::filter(day==tm), aes(x=Specificity, y=Sensitivity)) +
    geom_line(size=1) +
    geom_abline(intercept = 1, slope = 1, lty=2) +
    scale_x_reverse() +
    geom_text(data=df.text %>% dplyr::filter(day==tm), aes(x=x,y=y,label=label)) +
    coord_fixed() +
    theme_bw() + theme(panel.grid = element_blank())
}

bottom_row <- do.call("plot_grid", c(p2, align = "h", nrow=1))
plot_grid(p1, bottom_row, ncol=1, rel_heights = c(2, 1))

fn.fig = file.path(PROJECT_DIR, "figure_generation", "CHI_flow_vs_respones_3time_p")
ggsave(paste0(fn.fig, ".png"), w=7,h=7)
ggsave(paste0(fn.fig, ".pdf"), w=7,h=7)


library(Seurat)
fn = "data/H1_day0_scranNorm_adtbatchNorm_dist_clustered_TSNE_labels.rds"
h1 = readRDS(fn)

library(clustree)
library(ggraph)

dir.create("clustree_sig", showWarnings = F)

  # Get the graph layout
  layout <- clustree(h1@meta.data %>% dplyr::select(K1:K3), prefix = "K",
                     return = "layout")
  df.nodes = h1@meta.data %>% dplyr::select(K1:K3) %>%
    gather("K","cluster") %>%
    dplyr::mutate(node=paste0(K,"C",cluster)) %>%
    distinct() %>%
    dplyr::mutate(clr = str_extract(cluster, "C\\d"))
  inode = match(layout$node, df.nodes$node)

  # Add the statistic column (or whatever you want to show)
  layout$clr <- df.nodes$clr[inode]

  # Plot the graph (modified from clustree.R)
  gg <- ggraph::ggraph(layout)

  # Add the edges
  gg <- gg + geom_edge_link(#arrow = arrow(length = unit(1.5 * 5, "points"), ends = "last"),
                            end_cap = circle(9.5 * 1, "points"),
                            start_cap = circle(9.5 * 1, "points"),
                            aes_(
                                 alpha = ~in_prop,
                                 edge_width = ~is_core) ) +
    scale_edge_width_manual(values = c(1.5, 1.5),
                            guide = "none") +
    scale_edge_colour_gradientn(colours = viridis::viridis(256)) +
    scale_edge_alpha(limits = c(0, 1))

  # Add the node points (replace "statistic" with the column you want to show)
  gg <- gg + clustree:::add_node_points("clr", "size", 1, colnames(layout))

  # Add the node text

  # Plot theme
  gg <- gg + #scale_size(range = c(4, 15)) +
    ggraph::theme_graph(base_family = "",
                        plot_margin = ggplot2::margin(2, 2, 2, 2))

  cm = pals::glasbey(13)[c(1:3,5:9,13,11)]# %>% as.character()
  gg +
    scale_color_manual(values = cm) +
    scale_size_continuous(range = c(5, 30)) +
    coord_flip() +
    scale_x_reverse() +
    scale_y_reverse() +
    guides(size="none", edge_alpha="none", edge_color="none", color="none")

  dn.fig = "figures/cluster_annotation"
  dir.create(dn.fig, showWarnings = F, recursive = T)
  ggsave(glue::glue("{dn.fig}/clustree_clr_level1.png"), w=3, h=15)
  ggsave(glue::glue("{dn.fig}/clustree_clr_level1.pdf"), w=3, h=15, useDingbats=F, colormodel="rgb")


setwd("/home/remoteuser/Code/MRS")
source("SetComputeContext.r")

# For local compute context, skip the following line
startRxSpark()

finalData <- RxXdfData(file.path(dataDir, "joined5XDFSubset"))

################################################
# Split out Training and Test Datasets
################################################

# split out the training data

trainDS <- RxXdfData( file.path(dataDir, "finalDataTrainSubset" ))

rxDataStep( inData = finalData, outFile = trainDS,
            rowSelection = ( Year != 2012 ), overwrite = T )

# split out the testing data

testDS <- RxXdfData( file.path(dataDir, "finalDataTestSubset" ))

rxDataStep( inData = finalData, outFile = testDS,
            rowSelection = ( Year == 2012 ), overwrite = T )

################################################
# Train and Test a Logistic Regression model
################################################

formula <- as.formula(ArrDel15 ~ Month + DayofMonth + DayOfWeek + Carrier + OriginAirportID +
                        DestAirportID + CRSDepTime + CRSArrTime + RelativeHumidityOrigin +
                        AltimeterOrigin + DryBulbCelsiusOrigin + WindSpeedOrigin +
                        VisibilityOrigin + DewPointCelsiusOrigin + RelativeHumidityDest +
                        AltimeterDest + DryBulbCelsiusDest + WindSpeedDest + VisibilityDest +
                        DewPointCelsiusDest
)

# Use the scalable rxLogit() function

logitModel <- rxLogit(formula, data = trainDS)

options(max.print = 10000)
base::summary(logitModel)

# Predict over test data (Logistic Regression).

logitPredict <- RxXdfData(file.path(dataDir, "logitPredictSubset"))

# Use the scalable rxPredict() function

rxPredict(logitModel, data = testDS, outData = logitPredict,
          extraVarsToWrite = c("ArrDel15"),
          type = 'response', overwrite = TRUE)

# Calculate ROC and Area Under the Curve (AUC).

logitRoc <- rxRoc("ArrDel15", "ArrDel15_Pred", logitPredict)
logitAuc <- rxAuc(logitRoc)

plot(logitRoc)

save(logitModel, file = "logitModelSubset.RData")

# For local compute context, skip the following line
rxSparkDisconnect(rxGetComputeContext())


library(Cairo)

CairoSVG( 'contamination', width=2.5, height=5 )
par( mfrow=c(2,1), mai=c(1.5,.75,0,0) )

data = read.table("W:/2013_06_wnt_tgfb_crosstalk/TE20/TE20_summaryStats.csv",
                  sep=',',header=T,stringsAsFactors=F)
pValCutoff = .05
treatments = c( 'ctrl','Wnt3A.CFHP','Wnt3A',
                'Wnt3A+aTGFB','Wnt5A','Wnt5A.CF' )
outNames   = c( 'ctrl','Wnt3A(CF)','Wnt3A(LP)',
                'Wnt3A+aTGFB','Wnt5A','Wnt5A(LP/CF)' )
channels   = 2:3
readouts   = c('Smad2/3','B-catenin')
names(channels) = readouts
colors     = c('blue','darkred')
names(colors) = readouts

for( readout in readouts ){
  # Normalize the data to [0,1]
  feature    = paste('sum_nucleus.median',channels[readout],sep='.')
  values     = data[,feature]
  values     = values - mean(data[data$treatment == 'ctrl',feature])
  values     = values / (mean(data[data$treatment == 'Wnt3A',feature])-
                         mean(data[data$treatment == 'ctrl',feature]))

  plot( NA,NA, xlim=c(.5,length(treatments)+.5), xaxt='n',
        ylim=range(values)*1.05, yaxt='n', ylab=readout, xlab='')
  axis(1,at=1:length(treatments),outNames,las=3)
  axis(2,at=c(0,1))
  abline(h=0,col='gray',lty=3)
  abline(h=1,col='gray',lty=3)

  for( tIdx in 1:length(treatments)){
    theseValues = values[data$treatment == treatments[tIdx]]
    lines(c(tIdx,tIdx),mean(theseValues)+c(-1,1)*sd(theseValues),col=colors[readout])
    points( tIdx, mean(theseValues), col = colors[readout], pch=16)

    isEqCtrl = t.test(data[data$treatment == 'ctrl',feature],
                      data[data$treatment == treatments[tIdx],feature])$p.value
    if(isEqCtrl<pValCutoff){
      isEqCtrl = '*'
    }else{isEqCtrl = ''}

    axis(1,at=tIdx,isEqCtrl,tick=F)
  }
}

dev.off()