#this needs a way to filter by date using the UI
#Need a way to choose the starting and stop date. Can I display that in the UI somehow? Calendar?
#could use to pre-filter whats available between them, then have two drop downs with the second filtered to be later than the first
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#

######################################################company to company valuation metrics
#dailyCorrelation <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	open <- cor(df1$open, df2$open)
#	high <- cor(df1$high, df2$high)
#	low <- cor(df1$low, df2$low)
#	close <- cor(df1$close, df2$close)
#	volume <- cor(df1$volume, df2$volume)
#	return(data.frame(open, high, low, close, volume))
#}

#weeklyCorrelation <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	open <- cor(df1$open, df2$open)
#	high <- cor(df1$high, df2$high)
#	low <- cor(df1$low, df2$low)
#	close <- cor(df1$close, df2$close)
#	volume <- cor(df1$volume, df2$volume)
#	return(data.frame(open, high, low, close, volume))
#}

#monthlyCorrelation <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	open <- cor(df1$open, df2$open)
#	high <- cor(df1$high, df2$high)
#	low <- cor(df1$low, df2$low)
#	close <- cor(df1$close, df2$close)
#	volume <- cor(df1$volume, df2$volume)
#	return(data.frame(open, high, low, close, volume))
#}

#dailyVolumeDifference <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	volumeMeanDiff <- mean(abs(df1$volume - df2$volume))
#	volumeSdDiff <- sd(abs(df1$volume - df2$volume))
#	return(data.frame(volumeMeanDiff, volumeSdDiff))
#}

#weeklyVolumeDifference <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	volumeMeanDiff <- mean(abs(df1$volume - df2$volume))
#	volumeSdDiff <- sd(abs(df1$volume - df2$volume))
#	return(data.frame(volumeMeanDiff, volumeSdDiff))
#}

#monthlyVolumeDifference <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	volumeMeanDiff <- mean(abs(df1$volume - df2$volume))
#	volumeSdDiff <- sd(abs(df1$volume - df2$volume))
#	return(data.frame(volumeMeanDiff, volumeSdDiff))
#}

#earningPerShareDifference <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	return(data.frame(first = df1$earningsPerBasicShare, second = df2$earningsPerBasicShare))
#}

#debtToEquityDifference <- function(df1, df2) {
#	df1 <- df1 %>% filter(date %in% df2$date)
#	df2 <- df2 %>% filter(date %in% df1$date)
#	return(data.frame(first = df1$debtToEquityRatio, second = df2$debtToEquityRatio))
#}
#Histos for financial ratios for annual + quartlery they can be in different tabs

######################################################company to company valuation metrics


#######DESCRIPTION###############################
#processes raw merged satellite precipitation from NCAR
#TRMM + CMORPH + GsMAP
#outputs rdta object and csv
#################################################
##load libraries
library(dplyr)
library(data.table)
library(readr)
library(tidyr)
library(ncdf4)
list.dirs = function(path=".", pattern=NULL, all.dirs=FALSE,
  full.names=FALSE, ignore.case=FALSE) {
  # use full.names=TRUE to pass to file.info
  all <- list.files(path, pattern, all.dirs,
           full.names=TRUE, recursive=FALSE, ignore.case)
  dirs <- all[file.info(all)$isdir]
  # determine whether to return full names or just dir names
  if(isTRUE(full.names))
    return(dirs)
  else
    return(basename(dirs))
}
##user inputs
#raw file location
dir_raw = '/Volumes/gonggong/flood forecasting/data/raw/satprcp/'
#output location
dir_dat = '/Volumes/gonggong/flood forecasting/data/'

##process raw files
stadir_list = list.dirs(dir_raw)
prcp_dt = NULL
for(i in 1:length(stadir_list)){
	stadir_temp = stadir_list[i]
	file_list = list.files(paste0(dir_raw, stadir_temp), pattern = 'Q_satellite.*.dat')
	for(j in 1:length(file_list)){
		file_temp = file_list[j]
		filepath_temp = paste0(dir_raw, stadir_temp, '/', file_temp)
		to_read = file(filepath_temp, 'rb')
		header_temp = readBin(to_read, integer(), n = 4, size = 2, signed = T)
		nday_temp = header_temp[1]
		year_temp = header_temp[4]
		month_temp = header_temp[3]
		day_temp = header_temp[2]
		date_temp = seq(from = as.Date(paste(year_temp, month_temp, day_temp, sep = '-')), by = 'day', length.out = nday_temp)
		prcp_temp = readBin(to_read, numeric(), size = 4, n = nday_temp)
		close(to_read)
		prcp_temp_dt = data.table(sta_id = stadir_temp, date = date_temp, prcp = dat_temp)
		prcp_dt = rbind_list(prcp_dt, prcp_temp_dt)
	}
}
#output processed files
write.csv(prcp_dt, paste0(dir_dat, 'sat_prcp.csv'), row.names = F)
saveRDS(prcp_dt, paste0(dir_dat, 'sat_prcp.rda'))


library(arrow)
library(dplyr)

main <- function () {
    start_time <- Sys.time()
    files <- Sys.glob('/data/performance-benchmark-data/*.parquet')
    dataframes <- lapply(files[1:1], function(x) { read_parquet(x) })
    dataframe <- bind_rows(dataframes)
    dataframe %>%
        mutate(sales = price * quantity) %>%
        group_by(`member-id`) %>%
        summarise(total_spend = sum(sales),
                  avg_basket_size = mean(sales),
                  avg_price = mean(price),
                  n_transactions = n(),
                  n_visits = n_distinct(date),
                  n_brands = n_distinct(`brand-id`),
                  n_styles = n_distinct(`style-id`)) %>%
        write_parquet("dplyr.parquet")
    end_time <- Sys.time()
    print(end_time - start_time)
}

main()

df <- read_parquet("dplyr.parquet")
print(df)
head(df)
colnames(df)

# 1 Part
# Time difference of 7.683979 mins
# Without Docker
# Time difference of 7.343145 mins

# 12 Parts
# Time difference of 16.54721 mins
# Without Docker
# Time difference of 15.86956 mins


#rm(list=ls(all=TRUE))
results_fn="tmp/results-benchmark-binary/raw"
outtxt_fn="tmp/results-benchmark-binary/results-text.txt"

configs.loop=10
configs.labels=c("No Probe","Inactive Probe","Collecting Data","Writing Data","Reconstructing Data","Reducing Data")
configs.count=length(configs.labels)
results.count=100000000
results.skip=50000000

printvalues = matrix(nrow=7,ncol=configs.count,dimnames=list(c("mean","ci95%","md25%","md50%","md75%","max","min"),c(1:configs.count)))

cr=10
for (cc in (1:configs.count)) {
  resultsBIG <- c()
  for (cl in (1:configs.loop)) {
    results_fn_temp=paste(results_fn, "-", cl, "-", cr, "-", cc, ".csv", sep="")
    results=read.csv2(results_fn_temp,nrows=(results.count-results.skip),skip=results.skip,quote="",colClasses=c("NULL","numeric"),comment.char="",col.names=c("thread_id","duration_nsec"),header=FALSE)
    resultsBIG <- c(resultsBIG, results[["duration_nsec"]]/(1000))
    rm(results)
  }
  printvalues["mean",cc]=mean(resultsBIG)
  printvalues["ci95%",cc]=qnorm(0.975)*sd(resultsBIG)/sqrt(length(resultsBIG))
  printvalues[c("md25%","md50%","md75%"),cc]=quantile(resultsBIG,probs=c(0.25,0.5,0.75))
  printvalues["max",cc]=max(resultsBIG)
  printvalues["min",cc]=min(resultsBIG)
}
resultstext=formatC(printvalues,format="f",digits=4,width=8)
print(resultstext)
write("response time",file=outtxt_fn,append=TRUE)
write.table(resultstext,file=outtxt_fn,append=TRUE,quote=FALSE,sep="\t",col.names=FALSE)


library(ggplot2)

sods_data <- read.csv("stackoverflow-git-data.csv")

g <- ggplot(
  data = sods_data,
  mapping = aes(x = year, y = percentage)) +
  geom_point() +
  geom_smooth(method = "lm") +
  geom_text(
    aes(x = 2020, y = 82.8, label = "only GitHub"),
    nudge_x = 0.2,
    nudge_y = -4) +
  labs(
    x = "Year",
    y = "Percentage who used git",
    title = "Git usage has increased",
    subtitle = "Data from Stackoverflow Developer Survey")

ggsave(filename = "git-usage.png",
       plot = g,
       height = 7.4,
       width = 10.5,
       units = "cm")

sink(file = "regression-summary.txt")
summary(lm(percentage ~ year, data = sods_data))
sink()


library(tidyverse)
library(anytime)
library(scales)

# Load!
data_match <- read_csv("matched_comments.csv")
data_all <- read_csv("all_comments.csv")

# Create new date column from epoch
data_match <- data_match %>%
  mutate(datetime=as.POSIXct(Time, origin="1970-01-01"))

data_all <- data_all %>%
  mutate(datetime=as.POSIXct(Time, origin="1970-01-01"))

# Combine the data
data_combined <- bind_rows('Comments Matching Phrase' = data_match, 'All Comments' = data_all, .id="Color")

# Plot!
data_combined %>%
  ggplot(aes(x=datetime, y=ID)) +
  geom_line() +
  geom_area(aes(fill=Color, color=Color), position = "identity") +
  scale_fill_manual(values=c("All Comments"="dodgerblue", "Comments Matching Phrase"="pink2")) +
  scale_color_manual(values=c("All Comments"="dodgerblue4", "Comments Matching Phrase"="red")) +
  scale_x_datetime(expand=c(0,0), date_label="%H:%M", breaks=date_breaks("4 min")) +
  scale_y_sqrt(expand=c(0,0), breaks=trans_breaks(identity, identity, n = 10)) +
  theme(axis.text.x=element_text(angle = 90, vjust = 0.5), legend.position="bottom") +
  labs(x="Time (UTC)", y="Comments Per Minute", title="Uses of the Word ____ Reddit Thread ____")

# Save!
ggsave(filename="finalPlot.png", plot = last_plot(),
       width = 10, height = 5,
       units = "in",
       dpi = 300
)


# graphcsv.r: Graph an arbitrary set of time series data with first column of time and other columns integer values
# Use envars as input (see below)
#
# Input of the form:
#  Time,Col1,Col2,Col3...
#  2014-01-01 01:02:03,Col1Value,Col2Value,Col3Value...
#  2014-01-02 01:02:03,Col1Value,Col2Value,Col3Value...
#  2014-01-02 01:02:04,Col1Value,Col2Value,Col3Value...
#
# cat input.csv | R --silent --no-save -f timeplot.r
#
# NOTE: plot.xts requires at least 3 data points.
# WARNING: Newer versions of xtsExtra do not work. See http://stackoverflow.com/a/28590900/1293660

requiredLibraries = c("xts", "xtsExtra", "zoo", "txtplot")
installedLibraries = requiredLibraries[!(requiredLibraries %in% installed.packages()[,"Package"])]
if(length(installedLibraries)) install.packages(requiredLibraries, repos=c("http://cran.us.r-project.org","http://R-Forge.R-project.org"), quiet=FALSE)
library(zoo, warn.conflicts=FALSE)
library(xts, warn.conflicts=FALSE)
library(xtsExtra, warn.conflicts=FALSE)
library(txtplot, warn.conflicts=FALSE)
options(scipen=999)

title = if (nchar(Sys.getenv("INPUT_TITLE")) == 0) "TITLE" else Sys.getenv("INPUT_TITLE")
pngfile = if (nchar(Sys.getenv("INPUT_PNGFILE")) == 0) paste(title, ".png", sep="") else Sys.getenv("INPUT_PNGFILE")
pngwidth = as.integer(if (nchar(Sys.getenv("INPUT_PNGWIDTH")) == 0) "800" else Sys.getenv("INPUT_PNGWIDTH"))
pngheight = as.integer(if (nchar(Sys.getenv("INPUT_PNGHEIGHT")) == 0) "600" else Sys.getenv("INPUT_PNGHEIGHT"))
cols = as.integer(if (nchar(Sys.getenv("INPUT_COLS")) == 0) "1" else Sys.getenv("INPUT_COLS"))
timezone = if (nchar(Sys.getenv("TZ")) == 0) "UTC" else Sys.getenv("TZ")
Sys.setenv(TZ=timezone)
asciiwidth = as.integer(if (nchar(Sys.getenv("INPUT_ASCIIWIDTH")) == 0) "120" else Sys.getenv("INPUT_ASCIIWIDTH"))
asciicolumn = as.integer(if (nchar(Sys.getenv("INPUT_ASCIICOLUMN")) == 0) "0" else Sys.getenv("INPUT_ASCIICOLUMN"))
fontsize = as.numeric(if (nchar(Sys.getenv("INPUT_FONTSIZE")) == 0) "1.3" else Sys.getenv("INPUT_FONTSIZE"))
usexts = as.numeric(if (nchar(Sys.getenv("INPUT_USEXTS")) == 0) "1" else Sys.getenv("INPUT_USEXTS"))
zooylab = if (nchar(Sys.getenv("INPUT_ZOOYLAB")) == 0) "" else Sys.getenv("INPUT_ZOOYLAB")

data = as.xts(read.zoo(file="stdin", format = "%Y-%m-%d %H:%M:%S", header=TRUE, sep=",", tz=timezone))
if(asciicolumn>0) {
  x = sapply(index(data), function(time) {as.numeric(strftime(time, format = "%H%M"))})
  txtplot(x, data[,asciicolumn], width=asciiwidth, xlab=paste("Time (", timezone, ")", sep=""), ylab=dimnames(data)[[2]][asciicolumn])
}
png(pngfile, width=pngwidth, height=pngheight)
if(usexts) {
  plot.xts(
    data,
    main=paste(title, " (Timezone ", timezone, ")", sep=""),
    minor.ticks=FALSE,
    major.ticks=FALSE,
    yax.loc="left",
    auto.grid=TRUE,
    nc=cols,
    cex.lab=fontsize,
    cex.axis=fontsize,
    cex.main=fontsize,
    cex.sub=fontsize
  )
} else {
  zoodata = as.zoo(data)
  tsRainbow = rainbow(ncol(zoodata))
  plot.zoo(
    zoodata,
    xlab="Time",
    ylab=zooylab,
    main=paste(title, " (Timezone ", timezone, ")", sep=""),
    col=tsRainbow,
    screens=1
  )
  legend("topleft", legend=colnames(zoodata), lty = 1, col = tsRainbow)
}


root<- file.path("C:","MV","SMS","data_wb","WB SMS_til Morten")

plus<-data.frame(species=c('COD','HER','SPR'),plus=c(7,7,7))

### CANUM
a1<-read.csv(file=file.path(root,"cod_canum_weca_sd_sms.csv"))
a2<-read.csv(file=file.path(root,"her_canum_weca_sd_sms.csv"))
a3<-read.csv(file=file.path(root,"sprat_canum_weca_sd_sms.csv"))
a<-rbind(a1,a2,a3)
catch<-aggregate(CATCHN~year+quarter+sub_area+species+age,data=a,sum,na.rm=T)  # for weigthing purposes

a<-merge(a,plus)
a[a$age>a$plus,'age']<-a[a$age>a$plus,'plus']
a$plus<-NULL

a$obs<-NULL
a$PROP_landed<-1

a$yield<-a$WCATCH*a$CATCHN

a1<-a
a1$sub_area<-99

a2<-rbind(a,a1)
#ftable(round(tapply(a2$yield,list(a2$species,a2$year,a2$sub_area),sum,na.rm=T)/1000))

a$yield<-NULL

write.csv(a,file=file.path(root,"VPA_Ca01.in"),row.names = F)

###

# Bio
a1<-read.csv(file=file.path(root,"cod_wsea_mat_sd_sms.csv"))
a2<-read.csv(file=file.path(root,"her_wsea_mat_sd_sms.csv"))
a3<-read.csv(file=file.path(root,"sprat_wsea_mat_sd_sms.csv"))
a<-rbind(a1,a2,a3)
a$obs<-NULL
a$M<-0.2
a$M1<-0.2

a<-merge(a,catch)
a<-merge(a,plus)
a[a$age>a$plus,'age']<-a[a$age>a$plus,'plus']
a$plus<-NULL

a$WC<-a$WSEA*a$CATCHN
a$MC<-a$M*a$CATCHN
a$M1C<-a$M1*a$CATCHN
a$PC<-a$PROPMAT*a$CATCHN

a<-aggregate(cbind(CATCHN,WC,MC,M1C,PC)~year+quarter+sub_area+species+age,data=a,sum,na.rm=T)
a$M<-a$MC/a$CATCHN
a$M1<-a$M1C/a$CATCHN
a$PROPMAT<-a$PC/a$CATCHN
a$WSEA<-a$WC/a$CATCHN

ftable(round(tapply(a$WSEA,list(a$species,a$sub_area,a$year,a$quarter,a$age),sum,na.rm=T),3))

write.csv(a,file=file.path(root,"VPA_BI01.in"),row.names = F)
###

# distribution
a1<-read.csv(file=file.path(root,"cod_dist_key.csv"))
a2<-read.csv(file=file.path(root,"her_dist_key.csv"))
a3<-read.csv(file=file.path(root,"sprat_dist_key_SD 22_24.csv"))
a<-rbind(a1,a2,a3)

a<-merge(a,plus)
a<-subset(a,age<=plus)
a$plus<-NULL
a$obs<-NULL

ftable(round(tapply(a$prop*1000,list(a$species,a$year,a$quarter,a$sub_area,a$age),sum,na.rm=T),0))
write.csv(a,file=file.path(root,"distribution.in"),row.names = F)
###

#######################
# make data for one area (sd 22, 23 and 24 combined)

out.root<- file.path("C:","MV","SMS","data_wb","data-2014-one-area")

a<-read.csv(file=file.path(root,"VPA_Ca01.in"))

a$WC<-a$WCATCH*a$CATCHN
a$WP<-a$PROP_landed*a$CATCHN

a<-aggregate(cbind(WC,WP,CATCHN)~year+quarter+fleet+cat+species+age,data=a,sum)
a$WCATCH<-a$WC/a$CATCHN
a$PROP_landed<-a$WP/a$CATCHN
a$WC<-NULL; a$WP<-NULL
a$sub_area<-"A"
write.csv(a,file=file.path(out.root,"VPA_CA01.in"),row.names = F)

#
a<-read.csv(file=file.path(root,"VPA_BI01.in"))
b<-read.csv(file=file.path(root,"distribution.in"))
dim(a)
dim(b)
a<-merge(x=a,y=b,all.x=T)
dim(a)

a[is.na(a$prop),'prop']<-0.001
a$ww<-a$WSEA*a$prop
a$pp<-a$PROPMAT*a$prop
a$mm<-a$M*a$prop
a$mm1<-a$M1*a$prop
a<-aggregate(cbind(ww,pp,prop,mm,mm1)~year+quarter+species+age,data=a,sum)

a$WSEA<-a$ww/a$prop
a$PROPMAT<-a$pp/a$prop
a$M<-a$mm/a$prop
a$M1<-a$mm1/a$prop

head(a)
a$ww<-NULL
a$pp<-NULL
a$mm<-NULL
a$mm1<-NULL
a$prop<-NULL

a<-subset(a, !(age==0 & quarter %in% c(1,2)))
a$sub_area<-"A"

write.csv(a,file=file.path(out.root,"VPA_BI01.in"),row.names = F)


library(DESeq2)
library(tidyverse)
library(dplyr)

### Specify data path - must change for your own file system ###

# Path to BLASTp or BLASTx results
blast_path <- '/projectnb/talbot-lab-data/zrwerbin/metagenomes_raw/manuscript_test/metagenome_analysis//sunbeam_output/annotation/blastp/blastp_ncyc_allsamples.csv'
blastp_raw <- data.table::fread(blast_path, data.table = F)

# Path to NCycDB key (included in Github repo)
N_pathway_key <- read.csv('https://raw.githubusercontent.com/zoey-rw/metagenomes_NEON/main/NCycDB_pathways.csv',
													stringsAsFactors = F, strip.white = T)
# Path to metagenome metadata, NEON DP1.10107.001 (included in Github repo) - must download for total read countss
sequence_metadata <- read.csv("https://raw.githubusercontent.com/zoey-rw/metagenomes_NEON/main/metadata_metagenome.csv")

# Separate BLAST results into columns
# Note: Does not handle the "No definiton line" results well.
blastp <- blastp_raw %>%
	separate(V1, sep=".x", into=c("sampleID",NA)) %>%
	mutate(V2 = gsub("\\[|\\]| homolog|", "", V2)) %>%
	separate(V2, sep=c(" "), into = c("ID","gene","ontology","source")) %>%
	separate(gene, "=", into=c(NA, "gene")) %>%
	separate(ontology, "=", into=c(NA, "ontology")) %>%
	separate(source, "=", into=c(NA, "source")) %>%
	dplyr::rename(alignment_length = V3, e_val = V4)

# Add N-cycling pathway data
blastp$pathway <- N_pathway_key[match(blastp$gene, N_pathway_key$Gene_family),]$Pathway

# Get counts per gene
gene_counts <- blastp %>% filter(!grepl("Others", pathway) & !is.na(pathway)) %>%
	group_by(sampleID, gene) %>% add_count(name = "gene_count") %>%
	distinct(sampleID, gene, gene_count, .keep_all = T)

# Make sample names compatible
sequence_metadata$sampleID <- gsub("COMP-DNA1", "comp", sequence_metadata$sampleID)
# Prep count data for DeSeq
countdata <- merge(gene_counts, sequence_metadata, by = "sampleID") %>%
	mutate(norm = (gene_count/sampleTotalReadNumber)) %>%
	pivot_wider(id_cols = "gene", names_from = "sampleID", values_from = "gene_count", values_fill=0) %>%
	tibble::column_to_rownames("gene")

# prep sample data
coldata <- sequence_metadata %>% filter(sampleID %in% merged$sampleID)
rownames(coldata) <- coldata$sampleID
coldata <- coldata[colnames(countdata),]
coldata$siteID = substr(coldata$sampleID, 1, 4)
coldata$horizon = ifelse(grepl("-M-", coldata$sampleID), "M", "O")
coldata$X <- NULL

# Check that sample names match up
identical(colnames(countdata), rownames(coldata))

# Add column for "Other" read counts (those that did not match our genes of interest)
other <- coldata$sampleTotalReadNumber - colSums(countdata)
countdata <- rbind(countdata, other)

# create DE 'object'
ddsFullCountTable <- DESeqDataSetFromMatrix(
	countData = countdata,
	colData = coldata,
	design = ~ sampleID)
ddsFullCountTable
dds <- ddsFullCountTable

#as.data.frame( colData(ddsFullCountTable) )
sf <- estimateSizeFactors(dds)
normalized_counts <- counts(sf, normalized=TRUE) %>%
	data.frame() %>%
	rownames_to_column(var="gene")
gathered_normalized_counts <- normalized_counts %>%
	gather(colnames(normalized_counts)[2:3], key = "samplename", value = "normalized_counts")

# Merge with pathway and horizon data
merged <- merge(gathered_normalized_counts, N_pathway_key, all.y = F, by.x = "gene", by.y="Gene_family")
coldata$samplename <- gsub("-",".", coldata$sampleID)
merged <- merge(merged, coldata, all.y = F)

# subset to one pathway
merged <- merged %>% filter(grepl("Organic degradation and synthesis", Pathway))
## plot using ggplot2
ncyc <- ggplot(merged) +
	geom_point(aes(x = gene, y = normalized_counts, color = samplename), size = 3) +
	scale_y_log10() +
	#facet_grid(~Pathway, scales = "free", space = "free") +
	xlab("") +
	ylab("") +
	ggtitle("Organic degradation and synthesis genes") +
	theme_bw() +
	theme(text = element_text(size=20),
				axis.text.x = element_text(angle = 45, hjust = 1),
				plot.title = element_text(hjust = 0.5)) + labs(color = "Sample name")


#' Write a MODPATH pathline file into a simple feature (sf) vector file such as a shapefile
#'
#' This function takes as an argument a MODPATH pathline tibble (as generated using the readpathline
#' function) and converts the contents into an sf vector file such as a shapefile.
#' The pathline can be converted to real-world
#' coordinates using coordinate offsets and rotations. The pathline can also be modified by applying a
#' MAX_TIME limit that will only show pathlines that are less than or equal to the
#' threshold time limit (MAX_TIME).
#' @param df This is the data frame containing the pathline information. If this dataframe is not
#' present pth2sf will call readpathline using the supplied PATH. The default is NA.
#' @param ofl is the output vector file name (including the filepath) of the SF file.
#' @param X_off This is the global X coordinate offset.
#' @param Y_off This is the global Y coordinate offset.
#' @param ROT This is the rotation angle in units of degrees.
#' @param MAX_TIME is the maximum pathline travel time to be printed. This defaults to Inf.
#' @param PATH This is the full file path to the pathline file.
#' When PATH is NA and df is not supplied this function will look in the current working
#' directory for the pathline file.
#' @export

pth2shp <- function(df = NA,
                    ofl = NA,
                    PATH = NA,
                    X_off = 0,
                    Y_off = 0,
                    ROT = 0,
                    MAX_TIME = Inf){

                    PATH <- MFtools::pth2sf(df = df,
                                            X_off = X_off,
                                            Y_off = Y_off,
                                            ROT = ROT,
                                            MAX_TIME = MAX_TIME,
                                            PATH = PATH)

                    PATH %>% write_sf(ofl)
    }


pacman::p_load(tidyverse, rio)
pacman::p_load(ggh4x, ggtext)
pacman::p_load(patchwork, magick)

for (d in c(seq(1, 420, 2), 420) ) {

   vas_glm <- import('C:/R/Wonderful-Wednesdays/2021-05-12/vas_glm.rds') %>%
      filter(ady <= d)

   ref_df <- crossing(name = c('sym_d','dose_d','cumrem_d','cumrel_d'),
                      name2 = c('mean','diff'),
                      time = c('a','b','c'),
                      ref  = 1) %>%
      as.data.frame() %>%
      mutate(name  = as.factor(name) %>% fct_relevel('sym_d','dose_d','cumrem_d','cumrel_d'),
             name2 = as.factor(name2) %>% fct_relevel('mean','diff')) %>%
      filter(name2 != 'mean')

   axs_df <- crossing(name = c('sym_d','dose_d','cumrem_d','cumrel_d'),
                      name2 = c('mean','diff'),
                      nesting( ady = c(1, 168, 365, 420),
                               txt = c('a','b','c','d') )) %>%
      as.data.frame() %>%
      mutate(name  = as.factor(name) %>% fct_relevel('sym_d','dose_d','cumrem_d','cumrel_d'),
             name2 = as.factor(name2) %>% fct_relevel('mean','diff')) %>%
      filter(name2 == 'mean') %>%
      filter(name  == 'sym_d')

   vas_l_l <- vas_glm %>%
      group_by(name, name2, trt01pc) %>%
      slice(n()) %>%
      select(ady, name, name2, trt01pc, rate) %>%
      mutate(color = case_when(trt01pc == 'T'     ~ '#1b9e77',
                               trt01pc == 'P'     ~ '#d95f02',
                               trt01pc == 'T / P' ~ '#7f7f7f'))

   vas_l_l_s  <- vas_l_l %>% filter(name == 'sym_d', trt01pc %in% c('T','P'))
   vas_l_l_s2 <- vas_l_l %>% filter(name == 'sym_d', trt01pc %in% c('T / P'))

   vas_l_l_d  <- vas_l_l %>% filter(name == 'dose_d', trt01pc %in% c('T','P'))
   vas_l_l_d2 <- vas_l_l %>% filter(name == 'dose_d', trt01pc %in% c('T / P'))

   vas_l_l_c  <- vas_l_l %>% filter(name == 'cumrem_d', trt01pc %in% c('T','P'))
   vas_l_l_c2 <- vas_l_l %>% filter(name == 'cumrem_d', trt01pc %in% c('T / P'))

   vas_l_l_cl  <- vas_l_l %>% filter(name == 'cumrel_d', trt01pc %in% c('T','P'))
   vas_l_l_cl2 <- vas_l_l %>% filter(name == 'cumrel_d', trt01pc %in% c('T / P'))

   f1 <- ggplot(data = vas_glm,
                aes(x = ady, y =rate, color = trt01pc, fill = trt01pc)) +
      geom_hline(data = ref_df,
                 aes(yintercept = ref),
                 col = 'gray25') +
      geom_vline(xintercept = d, col = 'gray50') +
      geom_vline(xintercept = c(168, 365), col = 'gray65') +
      geom_line() +
      geom_point(data = vas_glm %>% filter(ady == d)) +
      geom_ribbon(data = . %>% filter(name2 == 'mean'),
                  aes(ymin=rate-SE, ymax=rate+SE),
                  alpha=0.5, colour = NA) +
      geom_ribbon(data = . %>% filter(name2 == 'diff'),
                  aes(ymin=asymp.LCL, ymax=asymp.UCL),
                  alpha=0.5, colour = NA) +

      geom_segment(data = axs_df,
                   x  = 1, xend = 365, y = 5.0, yend = 5.0,
                   arrow = arrow(length = unit(0.08,  "native"), type = "closed"),
                   inherit.aes = FALSE) +
      geom_label(data = axs_df,
                 x = 168, label = "On Treatment",
                 y = 5.4,
                 size = 3,
                 inherit.aes = FALSE) +
      geom_segment(data = axs_df,
                   x  = 366, xend = 420, y = 5.0, yend = 5.0,
                   arrow = arrow(length = unit(0.08,  "native"), type = "closed"),
                   inherit.aes = FALSE) +
      geom_label(data = axs_df,
                 x = 390, label = "Off Treatment",
                 y = 5.4,
                 size = 3,
                 inherit.aes = FALSE) +
      coord_cartesian(clip = "off") +
      facet_nested_wrap(vars(name, name2),
                        dir = 'v',
                        strip.position = "left",
                        ncol = 1,
                        scales = 'free_y',
                        labeller = as_labeller(c(sym_d    = "Vasculitis symptom score",
                                                 dose_d   = "Oral Corticosteroid dose",
                                                 cumrem_d = "Remission Event (cumulative)",
                                                 cumrel_d = "Relapse Event (cumulative)",
                                                 mean = 'Means',
                                                 diff = 'Ratio'))
      ) +
      facetted_pos_scales(y =list(
         scale_y_continuous(limits = c(0.5, 4.5),
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_s %>% pull(rate),
                               labels = str_glue("{vas_l_l_s$trt01pc  }"),
                               name = NULL
                            )),
         scale_y_continuous(limits = c(0.25, 4.5),
                            trans = "log10",
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_s2 %>% pull(rate),
                               labels = str_glue("{vas_l_l_s2$trt01pc  }"),
                               name = NULL
                            )),

         scale_y_continuous(limits = c(3.5, 15.2),
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_d %>% pull(rate),
                               labels = str_glue("{vas_l_l_s$trt01pc  }"),
                               name = NULL
                            )),
         scale_y_continuous(limits = c(0.30, 2.0),
                            trans = "log10",
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_d2 %>% pull(rate),
                               labels = str_glue("{vas_l_l_s2$trt01pc  }"),
                               name = NULL
                            )),

         scale_y_continuous(limits = c(0, 205),
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_c %>% pull(rate),
                               labels = str_glue("{vas_l_l_s$trt01pc  }"),
                               name = NULL
                            )),
         scale_y_continuous(limits = c(0.2, 11),
                            trans = "log10",
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_c2 %>% pull(rate),
                               labels = str_glue("{vas_l_l_s2$trt01pc  }"),
                               name = NULL
                            )),

         scale_y_continuous(limits = c(0, 3.0),
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_cl %>% pull(rate),
                               labels = str_glue("{vas_l_l_s$trt01pc  }"),
                               name = NULL
                            )),
         scale_y_continuous(limits = c(0.10, 5.0),
                            trans = "log10",
                            minor_breaks = NULL,
                            sec.axis = dup_axis(
                               breaks = vas_l_l_cl2 %>% pull(rate),
                               labels = str_glue("{vas_l_l_s2$trt01pc  }"),
                               name = NULL
                            )))
      )+
      scale_color_manual(values = c('T' = '#1b9e77',
                                    'P' = '#d95f02',
                                    'T / P' = '#7f7f7f'),
                         guide = FALSE) +
      scale_fill_manual(values = c('T' = '#1b9e77',
                                   'P' = '#d95f02',
                                   'T / P' = '#7f7f7f')) +
      scale_x_continuous(name = str_glue("Study Day: {d}"),
                         limits = c(0, 420),
                         breaks = c(1, 168, 365, 420),
                         labels = c("1", "168 days\n 24 wks", "365 days\n 52 wks", "420 days\n 60 wks"),
                         expand = c(0.01, 0.01),
                         minor_breaks = NULL) +
      labs(y = NULL) +
      theme_bw(base_size = 10) +
      theme(
         plot.margin = unit(c(1.5, 0.5, 0.5, 0.5), units="lines"),
         legend.position = "none",
         strip.placement = "outside",
         axis.text.x = element_text(hjust = 1),
         axis.text.y.right= element_markdown()
      )

   f2 <- ggplot(data = vas_glm ,
                aes(y = rate, fill = trt01pc)) +
      geom_hline(data = ref_df,
                 aes(yintercept = ref),
                 col = 'gray25') +
      geom_boxplot(varwidth = TRUE, alpha = 0.5, outlier.shape = NA) +
      facet_nested(rows = vars(name,name2),
                   cols = vars(time),
                   scales = 'free_y',
                   labeller = as_labeller(c(sym_d    = "Vasculitis symptom score",
                                            dose_d   = "Oral Corticosteroid dose",
                                            cumrem_d = "Remission Event (cumulative)",
                                            cumrel_d = "Relapse Event (cumulative)",
                                            mean = 'Means',
                                            diff = 'Ratio',
                                            a = '0-24 wks',
                                            b = '24-52 wks',
                                            c = '52-60 wks'))
      ) +
      facetted_pos_scales(y =list(
         scale_y_continuous(limits = c(0.5, 4.5),
                            minor_breaks = NULL),
         scale_y_continuous(limits = c(0.25, 4.5),
                            trans = "log10",
                            minor_breaks = NULL),

         scale_y_continuous(limits = c(3.5, 15.2),
                            minor_breaks = NULL),
         scale_y_continuous(limits = c(0.30, 2.0),
                            trans = "log10",
                            minor_breaks = NULL),

         scale_y_continuous(limits = c(0, 205),
                            minor_breaks = NULL),
         scale_y_continuous(limits = c(0.2, 11),
                            trans = "log10",
                            minor_breaks = NULL),

         scale_y_continuous(limits = c(0, 3.0),
                            minor_breaks = NULL),
         scale_y_continuous(limits = c(0.10, 5.0),
                            trans = "log10",
                            minor_breaks = NULL))
      ) +
      scale_color_manual(values = c('T' = '#1b9e77',
                                    'P' = '#d95f02',
                                    'T / P' = '#7f7f7f'),
                         guide = FALSE) +
      scale_fill_manual(values = c('T' = '#1b9e77',
                                   'P' = '#d95f02',
                                   'T / P' = '#7f7f7f'),
                        labels = c("P",
                                   "T",
                                   "Ratio")) +
      labs(y = NULL,
           fill = NULL) +
      theme_bw(base_size = 10) +
      theme(
         legend.position = "none",
         strip.placement = "outside",
         axis.title.x=element_blank(),
         axis.text.x=element_blank(),
         axis.ticks.x=element_blank(),
         panel.grid.major.x = element_blank(),
         panel.grid.minor.x = element_blank()
      )

   f1 + f2 +
      plot_layout(widths = c(4, 1.5))

   ggsave(
      str_glue("C:/R/Wonderful-Wednesdays/2021-05-12/vas-fig-gif/fig-gif_{str_pad(d, 3, pad='0')}.png"),
      width = 14,
      height = 8)

}

# unlink("C:/R/Wonderful-Wednesdays/2021-05-12/fig-gif/*", recursive = T, force = T)
pacman::p_load(gifski)

lf <- list.files (path = "C:/R/Wonderful-Wednesdays/2021-05-12/vas-fig-gif",
                  pattern = c(".png"),
                  full.names = TRUE)

gifski(png_files = lf,
       gif_file = "C:/R/Wonderful-Wednesdays/2021-05-12/vas-fig-gif.gif",
       width = 4200,
       height = 2400,
       delay = 0.15 )


# Figures - Smith et al

library(pheatmap)
library(RColorBrewer)
library(colorspace)
library(R.utils)
library(stringr)
library(superheat)
library(sm)
library(vioplot)

# Read in processed data table for CPM and FPKM values from Tasic et al, Nature,  2018 Nov;563(7729):72-78
# This table contains expression profiles for 23,823 cells from VISp and ALM cortical regions together with laminar location and cluster id.
# All figures and analyses can be generated from this code.

np_gpcr_cpm=as.data.frame(read.csv("/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/np_gpcr_cpm.csv"))
np_gpcr_cpm=as.data.frame(read.csv("F:\\Analysis\\Neuropeptides\\Submission\\np_gpcr_cpm.csv"))

# membership of cell types in Tasic and membership in major cell types
celltype=read.csv("/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/CellTypeAnnotation.csv",header=F)
celltype=read.csv("F:\\Analysis\\Neuropeptides\\Submission\\CellTypeAnnotation.csv",header=F)

# Gene classes of interest: NPP
nppm=c("Npy","Sst","Vip","Tac2", "Cck","Penk","Crh","Cort", "Tac1", "Pdyn", "Pthlh", "Pnoc","Trh","Grp","Rln1","Adcyap1","Nts","Nmb")
npph=toupper(nppm)

# NP-GPCR
npgpcrm=c("Sstr2", "Npy2r", "Npy1r", "Grpr", "Cckbr", "Ntsr2", "Npy5r", "Nmbr", "Rxfp1", "Sstr4",
          "Trhr","Sstr1","Adcyap1r1","Crhr1","Rxfp3","Oprl1","Crhr2","Tacr3","Oprk1","Tacr1",
          "Pth1r","Vipr1","Oprm1","Trhr2","Vipr2","Rxfp2","Oprd1","Ntsr1","Sstr3")

# twelve basic cell types for pooling results to coarser resolution
ctpool=c("IT","PT","NP","CT","L6b","Lamp5","Sncg","Serpinf1","VIP","Sst Chodl","Sst","Pvalb")
ctcolors=c("#A1D5BA","#7AB7AB","#BEDFCB","#9ECAE8","#91ACBA","#F2ABB7","#C387E2","#E6B8FF","#D5A8DF","#FEFF99","#E0B889","#EE98A4")
names(ctcolors)=ctpool

# totalnumber of types in taxonomy
cellind=1:133

# cell type membership data, types and colors for VISp and ALM regional analysis

allclust=read.csv("/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/All_Types.csv")
allclust=read.csv("F:\\Analysis\\Neuropeptides\\Submission\\All_Types.csv")
allclid=as.integer(allclust[,2])
alldend=as.integer(allclust[,1])

almclust=read.csv("/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/AlM_Types.csv")
almclust=read.csv("F:\\Analysis\\Neuropeptides\\Submission\\ALM_Types.csv")
almclid=as.integer(almclust[,2])
almdend=as.integer(almclust[,1])

visclust=read.csv("/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/VISp_Types.csv")
visclust=read.csv("F:\\Analysis\\Neuropeptides\\Submission\\VISp_Types.csv")
visclid=as.integer(visclust[,2])
visdend=as.integer(visclust[,1])

# Cell type lists for pooling to 12 major types, these give the index map for the 12 major cell types for each region

vislist=NULL
icount=0
for (i in 1:12) {
  itemp=intersect(which(celltype[,4]==i),visdend)
  vislist[[i]]=c((icount+1):(icount+length(itemp)))
  icount=icount+length(itemp)
}

almlist=NULL
icount=0
for (i in 1:12) {
  itemp=intersect(which(celltype[,4]==i),almdend)
  almlist[[i]]=c((icount+1):(icount+length(itemp)))
  icount=icount+length(itemp)
}

alllist=NULL
icount=0
for (i in 1:12) {
  itemp=intersect(which(celltype[,4]==i),alldend)
  alllist[[i]]=c((icount+1):(icount+length(itemp)))
  icount=icount+length(itemp)
}

# table of 37 interaction pairs and
inpairs=read.csv("F:\\Analysis\\Neuropeptides\\Submission\\CognatePairs.csv",header=FALSE)
inpairs=read.csv("/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/CognatePairs.csv",header=FALSE)

######################################################
#  Figure 1B. Fraction of Cells Expressing NPP
######################################################

# Note: run all plotting subroutines below

# ALM - NPP
d1=subset(np_gpcr_cpm,brain_region_label=="ALM",nppm)
cvec=sum(apply(d1,1,sum)>0)
totcell=dim(d1)[1]
bimat=d1>0
almcnt=c(1,cvec/totcell,apply(bimat,2,sum)/totcell)
b1=almcnt[-1]
names(almcnt)[1]="ALM"
names(almcnt)[2]="Any NPP"
names(b1)[1]="Any"
pervec_alm=almcnt[c(-1,-2)]

# VISp - NPP
d1=subset(np_gpcr_cpm,brain_region_label=="VISp",nppm)
cvec=sum(apply(d1,1,sum)>0)
totcell=dim(d1)[1]
bimat=d1>0
almcnt=c(1,cvec/totcell,apply(bimat,2,sum)/totcell)
b2=almcnt[-1]
names(almcnt)[1]="VISp"
names(almcnt)[2]="Any NPP"
pervec_visp=almcnt[c(-1,-2)]

# dual plot
c1=rbind(b1,b2)
row.names(c1)=c("ALM","VISp")
cr1=terrain_hcl(19)[5]
cr2=terrain_hcl(19)[11]

par(las=2)
par(fig = c(0,1,0,1))
barplot(c1,col=rbind(rep(cr1,14),rep(cr2,14)),ylim=c(0,1),beside=TRUE,main="NPP Expressing Cells - ALM and VISp")
legend(40,0.8,legend=c("ALM","VISp"),col=c(cr1,cr2),pch=c(15,15),box.lty=0,pt.cex=1.5,cex=1.25)

##########################################################
#  Figure 1C. Histogram for NPP Expressing Cells
##########################################################

d1=subset(np_gpcr_cpm,brain_region_label=="ALM",nppm)
totcell=dim(d1)[1]
dpos=d1>0
fvec=apply(dpos,1,sum)
tvec=table(fvec)
tvecn=tvec/sum(tvec[2:length(tvec)])
tvec1=tvecn

d1=subset(np_gpcr_cpm,brain_region_label=="VISp",nppm)
totcell=dim(d1)[1]
dpos=d1>0
fvec=apply(dpos,1,sum)
tvec=table(fvec)
tvecn=tvec/sum(tvec[2:length(tvec)])
tvec2=tvecn

# dual plot
c1=rbind(b1,b2)
row.names(c1)=c("ALM","VISp")
cr1=terrain_hcl(19)[5]
cr2=terrain_hcl(19)[11]

# in case one array is longer pad with terminal zeros
difl=length(tvec1)-length(tvec2)
if (difl > 0) {
  tvec2=c(tvec2,rep(0,difl))
  names(tvec2)=names(tvec1)
}
if (difl < 0) {
  tvec1=c(tvec1,rep(0,abs(difl)))
  names(tvec1)=names(tvec2)
}

outr=rbind(tvec1,tvec2)

par(las=1)
barplot(outr,col=rbind(rep(cr1,12),rep(cr2,12)),ylim=c(0,0.2),beside=TRUE,
        ylab="Histogram Frac. NPP expressing",cex.names=1.2)
title(main="Histogram of NPP expressing cells in ALM and VISp")
par(mar=c(5, 4, 4, 2.7) + 0.1)
legend(30,0.15,legend=c("ALM","VISp"),col=c(cr1,cr2),pch=c(15,15),box.lty=0,pt.cex=1.5,cex=1.25)

#########################################################
#  Figure 2B. Fraction of Cells Expressing NP-GPCR
#########################################################

d1=subset(np_gpcr_cpm,brain_region_label=="ALM",npgpcrm)
cvec=sum(apply(d1,1,sum)>0)
totcell=dim(d1)[1]
bimat=d1>0
almcnt=c(1,cvec/totcell,apply(bimat,2,sum)/totcell)
b1=almcnt[-1]
names(almcnt)[1]="ALM"
names(b1)[1]="Any NP-GPCR"
pervec_alm=almcnt[c(-1,-2)]

d1=subset(np_gpcr_cpm,brain_region_label=="VISp",npgpcrm)
cvec=sum(apply(d1,1,sum)>0)
totcell=dim(d1)[1]
bimat=d1>0
almcnt=c(1,cvec/totcell,apply(bimat,2,sum)/totcell)
b2=almcnt[-1]
names(almcnt)[1]="ALM"
names(almcnt)[2]="Any NP-GPCR"
names(b1)[1]="Any NP-GPCR"
pervec_alm=almcnt[c(-1,-2)]

# dual plot
c1=rbind(b1,b2)
row.names(c1)=c("ALM","VISp")
cr1=rainbow_hcl(19)[5]
cr2=rainbow_hcl(19)[11]

par(las=2)
barplot(c1,col=rbind(rep(cr1,14),rep(cr2,14)),ylim=c(0,1),beside=TRUE,main="NP-GPCR Expressing Cells - ALM and VISp")
legend(70,0.8,legend=c("ALM","VISp"),col=c(cr1,cr2),pch=c(15,15),box.lty=0,pt.cex=1.5,cex=1.25)

###################################################################
#  Fraction of cell types expressing NP-GPCR and cognate pairs
###################################################################

commat=matrix(0,dim(inpairs)[1],118)

for (i in 1:dim(inpairs)[1]) {
  np1=as.character(inpairs[i,2])
  np2=as.character(inpairs[i,3])
  ipos=which(((np_gpcr_cpm[,np1]>0)*(np_gpcr_cpm[,np2]>0))==1)
  lipos=length(ipos)
  itab=table((np_gpcr_cpm[,"cluster_id"])[ipos])[alldend]
  commat[i,as.integer(names(itab))]=as.integer(itab)
}

##########################################################
#  Figure 2C. Histogram for NP-GPCR Expressing Cells
##########################################################

d1=subset(np_gpcr_cpm,brain_region_label=="ALM",npgpcrm)
totcell=dim(d1)[1]
dpos=d1>0
fvec=apply(dpos,1,sum)
tvec=table(fvec)
tvecn=tvec/sum(tvec[2:length(tvec)])
tvec1=tvecn

d1=subset(np_gpcr_cpm,brain_region_label=="VISp",npgpcrm)
totcell=dim(d1)[1]
dpos=d1>0
fvec=apply(dpos,1,sum)
tvec=table(fvec)
tvecn=tvec/sum(tvec[2:length(tvec)])
tvec2=tvecn

# dual plot
c1=rbind(tvec1,tvec2)
row.names(c1)=c("ALM","VISp")
cr1=rainbow_hcl(19)[5]
cr2=rainbow_hcl(19)[11]

# in case one array is longer pad with terminal zeros
difl=length(tvec1)-length(tvec2)
if (difl > 0) {
  tvec2=c(tvec2,rep(0,difl))
  names(tvec2)=names(tvec1)
}
if (difl < 0) {
  tvec1=c(tvec1,rep(0,abs(difl)))
  names(tvec1)=names(tvec2)
}

outr=rbind(tvec1,tvec2)

par(las=1)
barplot(outr,col=rbind(rep(cr1,12),rep(cr2,12)),ylim=c(0,0.2),beside=TRUE,
        ylab="Histogram Frac. NP-GPCR Expressing")
title(main="Histogram of NP-GPCR expressing cells in ALM and VISp")
par(mar=c(5, 4, 4, 2.7) + 0.1)
legend(40,0.15,legend=c("ALM","VISp"),col=c(cr1,cr2),pch=c(15,15),box.lty=0,pt.cex=1.5,cex=1.25)

#####################################################################################
#  Figure 3A. Basic expression plots and variability for NPP - Combined VISp and ALM
#####################################################################################

alltyp=133
clabel=paste("CT",c(1:alltyp),sep="")

nppmat=matrix (0,length(nppm),alltyp,dimnames=list(nppm,clabel))

for (i in 1:length(nppm)) {
  ip1=which(names(np_gpcr_cpm)==nppm[i])
  for (j in 1:alltyp) {
    ip2=which(np_gpcr_cpm[,6]==j)
     nppmat[i,j]=mean(np_gpcr_cpm[ip2,ip1],trim=0.05)
  }
}

vmat=nppmat[,allclid]

# log before normalization
vmat=log10(vmat+1)

# before normalization and plotting, compute mean variation within major cell types compared to total variation

varmat=matrix(0,dim(vmat)[1],length(ctpool)+1,dimnames=list(rownames(vmat),c("All",ctpool)))

for (i in 1:dim(vmat)[1]) {
  varmat[i,1]=var(vmat[i,])/mean(vmat[i,])
}
for (i in 1:dim(vmat)[1]) {
  for (j in 1:length(ctpool)) {
    if (length(vmat[i,alllist[[j]]]) > 1)
      if (mean(vmat[i,alllist[[j]]])>0) {
      varmat[i,j+1]=var(vmat[i,alllist[[j]]])/mean(vmat[i,alllist[[j]]])
      }
    }
}

varmat_npp=varmat

#####################################################################
#  Figure 3C. Violin plots NPP variability over major types
#####################################################################

# create data frame for variability plots
varmatm=as.data.frame(varmat[,-11])
labn=colnames(varmatm)
longd=NULL
for (j in 1:dim(varmatm)[2]) {
  longd=rbind(longd,cbind(varmatm[,j],rep(labn[j],dim(varmatm)[1])))
}
longdf=as.data.frame(longd)
colnames(longdf)=c("dat","reg")
longdfp=longdf[as.numeric(as.character(longdf[,1]))>0,]

cvec=c(rgb(0.75,0.75,0.75),ctcolors)
names(cvec)[1]="All"
lcvec=NULL
for (i in 1:12) {
  lcvec=c(lcvec,rep(cvec[i],18))
}
longdf2=cbind(longdf,lcvec)

par(fig = c(0,1,0,1))
par(las=1)
vioplot(as.numeric(as.character(longdfp[longdfp$reg=="All",1])),as.numeric(as.character(longdfp[longdfp$reg=="IT",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="PT",1])),as.numeric(as.character(longdfp[longdfp$reg=="NP",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="CT",1])),as.numeric(as.character(longdfp[longdfp$reg=="L6b",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="Lamp5",1])),as.numeric(as.character(longdfp[longdfp$reg=="Sncg",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="Serpinf1",1])),as.numeric(as.character(longdfp[longdfp$reg=="VIP",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="Sst",1])),as.numeric(as.character(longdfp[longdfp$reg=="Pvalb",1])),col=cvec[-11],
        names=names(cvec)[-11],cex.axis=1.75,main="NPP expression variability",cex.main=1.5,axes=F,ylim=c(0,2.5),
        font.axis=1)
 points(2,max(varmatm[,2]),cex=1.25,pch=16)
 points(3,max(varmatm[,3]),cex=1.25,pch=16)
 points(4,max(varmatm[,4]),cex=1.25,pch=16)
 points(5,max(varmatm[,5]),cex=1.25,pch=16)
 points(6,max(varmatm[,6]),cex=1.25,pch=16)
 points(7,max(varmatm[,7]),cex=1.25,pch=16)
 points(8,max(varmatm[,8]),cex=1.25,pch=16)
 points(9,max(varmatm[,9]),cex=1.25,pch=16)
 points(10,max(varmatm[,10]),cex=1.25,pch=16)
 points(11,max(varmatm[,11]),cex=1.25,pch=16)
 points(11,max(varmatm[,11]),cex=1.25,pch=16)
 points(12,max(varmatm[,12]),cex=1.25,pch=16)
 points(12,max(varmatm[,12]),cex=1.25,pch=16)

 # barplot for ratios on same plot
 mbarv=vector("numeric",11)
 mall=mean(varmatm[,1])
 for (j in 2:dim(varmatm)[2]) {
   mbarv[j-1]=mean(varmatm[varmatm[,j]>0,j])/mall
 }

 par(fig = c(0.75,0.95,0.65,1.0),new=TRUE,las=2)
 barplot(mbarv,names.arg=colnames(varmatm)[-1],col=ctcolors[-10],cex.names=0.75,cex.axis=0.75,ylab="Relative CV")
 abline(h=mean(mbarv),lty=2)

# Supplementary data for Figure 3 variability plots

varmatn=varmat[,-c(1,11)]
sumvec=apply(varmatn,2,mean)
ov=order(sumvec,decreasing=T)
pmat=varmatn[,ov]

covo=names(sumvec[ov])
pmatn=pmat
mypal=colorRampPalette(c(rgb(1,1,1),rgb(0.25,0.25,0.25)),bias=3)(10)
mypal=rev(colorRampPalette(brewer.pal(8,"Spectral"),bias=1)(8))

c1=brewer.pal(8,"Spectral")[1]
c8=brewer.pal(8,"Spectral")[8]
mypal=rev(colorRampPalette(c(rgb(0.75,0.4,1,0.75), rgb(0.75,0.4,1,0)), alpha = TRUE)(8))

imname="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/cell_type_variability_npp.tiff"
imname="F:\\Analysis\\Neuropeptides\\Submission\\cell_type_variability_npp.tiff"

tiff(imname,width=1500,height=1100)
par(cex.axis=1.5)
superheat(X=pmatn,left.label.col=c("ivory","ivory2"),bottom.label.col=ctcolors[covo],legend.text.size=14,
          left.label.text.alignment="center",X.text=round(pmatn,2),X.text.size=8,heat.pal=c("white","tan1"),yt=sumvec[covo],
          yt.axis.name="Mean cell type CV / Global CV",yt.plot.type="bar",yt.axis.size=18,yt.axis.name.size=16,yt.obs.col=ctcolors[covo],
          left.label.text.size=8,bottom.label.text.size=9)
dev.off()

# normalalize to row maximum
for (i in 1:dim(vmat)[1])  {
  print(paste(rownames(nppmat)[i],round(max(vmat[i,]),3)))
  vmat[i,]=vmat[i,]/max(vmat[i,])
}

# run plotting subroutines first
plot_All(vmat,"NPP expression in ALM and VISp",1)

# expression pooled to 12 major types
plot_All_pooled(vmat,"NPP expression in ALM and VISp",1)

############################################################
#  Figure 3B. Basic expression plots for NP-GPCR - Combined
############################################################

alltyp=133
clabel=paste("CT",c(1:alltyp),sep="")

nppmat=matrix(0,length(npgpcrm),alltyp,dimnames=list(npgpcrm,clabel))

for (i in 1:length(npgpcrm)) {
  ip1=which(names(np_gpcr_cpm)==npgpcrm[i])
  for (j in 1:alltyp) {
    ip2=which(np_gpcr_cpm[,6]==j)
    nppmat[i,j]=mean(np_gpcr_cpm[ip2,ip1],trim=0.05)
  }
}

vmat=nppmat[,allclid]

# log before normalization
vmat=log10(vmat+1)

# before normalization and plotting, compute mean variation within major cell types compared to total variation

varmat=matrix(0,dim(vmat)[1],length(ctpool)+1,dimnames=list(rownames(vmat),c("All",ctpool)))

for (i in 1:dim(vmat)[1]) {
  varmat[i,1]=var(vmat[i,])/mean(vmat[i,])
}
for (i in 1:dim(vmat)[1]) {
  for (j in 1:length(ctpool)) {
    if (length(vmat[i,alllist[[j]]]) > 1)
      if (mean(vmat[i,alllist[[j]]])>0) {
        varmat[i,j+1]=var(vmat[i,alllist[[j]]])/mean(vmat[i,alllist[[j]]])
      }
  }
}

varmat_npgpcr=varmat

#####################################################################
#  Figure 3D. Violin plots for NP-GPCR variability over major types
#####################################################################

varmatm=as.data.frame(varmat[,-11])
labn=colnames(varmatm)
longd=NULL
for (j in 1:dim(varmatm)[2]) {
  longd=rbind(longd,cbind(varmatm[,j],rep(labn[j],dim(varmatm)[1])))
}
longdf=as.data.frame(longd)

colnames(longdf)=c("dat","reg")
longdfp=longdf[as.numeric(as.character(longdf[,1]))>0,]

# violin plot for cv variability

cvec=c(rgb(0.75,0.75,0.75),ctcolors)
names(cvec)[1]="All"
lcvec=NULL
for (i in 1:12) {
  lcvec=c(lcvec,rep(cvec[i],29))
}
longdf2=cbind(longdf,lcvec)

par(fig = c(0,1,0,1))
par(las=1)
vioplot(as.numeric(as.character(longdfp[longdfp$reg=="All",1])),as.numeric(as.character(longdfp[longdfp$reg=="IT",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="PT",1])),as.numeric(as.character(longdfp[longdfp$reg=="NP",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="CT",1])),as.numeric(as.character(longdfp[longdfp$reg=="L6b",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="Lamp5",1])),as.numeric(as.character(longdfp[longdfp$reg=="Sncg",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="Serpinf1",1])),as.numeric(as.character(longdfp[longdfp$reg=="VIP",1])),
        as.numeric(as.character(longdfp[longdfp$reg=="Sst",1])),as.numeric(as.character(longdfp[longdfp$reg=="Pvalb",1])),col=cvec[-11],
        names=names(cvec)[-11],cex.axis=1.75,main="NP-GPCR expression variability",cex.main=1.5,axes=F,ylim=c(0,2),
        font.axis=1)
points(2,1.7113,cex=1.25,pch=16)
points(3,1.027,cex=1.55,pch=16)
points(4,0.821417,cex=1.55,pch=16)
points(5,0.7069,cex=1.25,pch=16)
points(6,0.95626,cex=1.25,pch=16)
points(7,1.4198,cex=1.25,pch=16)
points(7,1.1718,cex=1.25,pch=16)
points(8,0.9220,cex=1.25,pch=16)
points(9,1.2237,cex=1.25,pch=16)
points(10,1.127,cex=1.25,pch=16)
points(11,1.38148,cex=1.25,pch=16)
points(11,1.228,cex=1.25,pch=16)
points(12,1.446,cex=1.25,pch=16)
points(12,1.338,cex=1.25,pch=16)

mbarv=vector("numeric",11)
mall=mean(varmatm[,1])
for (j in 2:dim(varmatm)[2]) {
  mbarv[j-1]=mean(varmatm[varmatm[,j]>0,j])/mall
}

par(fig = c(0.75,0.95,0.65,1.0),new=TRUE,las=2)
barplot(mbarv,names.arg=colnames(varmatm)[-1],col=ctcolors[-10],cex.names=0.75,cex.axis=0.75,ylab="Relative CV")
abline(h=mean(mbarv),lty=2)

# Supplementary data for Figure 3 variability plots

varmatn=varmat[,-c(1,11)]
sumvec=apply(varmatn,2,mean)
ov=order(sumvec,decreasing=T)
pmat=varmatn[,ov]

covo=names(sumvec[ov])
pmatn=pmat
mypal=colorRampPalette(c(rgb(1,1,1),rgb(0.25,0.25,0.25)),bias=3)(10)
mypal=rev(colorRampPalette(brewer.pal(8,"Spectral"),bias=1)(8))

c1=brewer.pal(8,"Spectral")[1]
c8=brewer.pal(8,"Spectral")[8]
mypal=rev(colorRampPalette(c(rgb(0.75,0.4,1,0.75), rgb(0.75,0.4,1,0)), alpha = TRUE)(8))

imname="/volumes/PHILIPS UFD/Analysis/Neuropeptides/cell_type_variability_np-gpcr.tiff"
imname="F:\\Analysis\\Neuropeptides\\Submission\\cell_type_variability_np-gpcr.tiff"

tiff(imname,width=1500,height=1500)
par(cex.axis=1.5)
superheat(X=pmatn,left.label.col=c("ivory","ivory2"),bottom.label.col=ctcolors[covo],legend.text.size=14,
          left.label.text.alignment="center",X.text=round(pmatn,2),X.text.size=8,heat.pal=c("white","tan1"),yt=sumvec[covo],
          yt.axis.name="Mean cell type CV / Global CV",yt.plot.type="bar",yt.axis.size=18,yt.axis.name.size=16,yt.obs.col=ctcolors[covo],
          left.label.text.size=8,bottom.label.text.size=9)
dev.off()

for (i in 1:dim(vmat)[1])  {
  print(paste(rownames(nppmat)[i],round(max(vmat[i,]),3)))
  vmat[i,]=vmat[i,]/max(vmat[i,])
}

plot_All(vmat,"NP-GPCR expression in ALM and VISp",1)
plot_All_pooled(vmat,"NP-GPCR expression in ALM and VISp",1)

colnames(vmat)=paste("CT",alldend,sep="")
write.csv(vmat,"F:\\Analysis\\Neuropeptides\\FigureData\\Figure3B.csv")

#  try plotting one large

combmat=rbind(varmat_npp,varmat_npgpcr)
combn=combmat[,-c(1,11)]

pheatmap(combn)

##################################
# 5A.  NPP: VISp Expression
##################################

d1=subset(np_gpcr_cpm,brain_region_label=="VISp")

alltyp=133
clabel=paste("CT",c(1:alltyp),sep="")

nppmat=matrix(0,length(nppm),alltyp,dimnames=list(nppm,clabel))

for (i in 1:length(nppm)) {
  ip1=which(names(d1)==nppm[i])
  for (j in 1:alltyp) {
    ip2=which(d1[,6]==j)
    nppmat[i,j]=mean(d1[ip2,ip1],trim=0.05)
  }
}

vmat=nppmat[,visclid]

vmat_npp_visp=vmat

# log before normalization
vmat=log10(vmat+1)

for (i in 1:dim(vmat)[1])  {
  print(paste(rownames(nppmat)[i],round(max(vmat[i,]),3)))
  vmat[i,]=vmat[i,]/max(vmat[i,])
}

plot_VISp(vmat,"NPP expression in VISp",1)

colnames(vmat)=paste("CT",visdend,sep="")
write.csv(vmat,"F:\\Analysis\\Neuropeptides\\FigureData\\Figure5A.csv")

######################################
# 5B.  NP-GPCR: VISp Expression
######################################

d1=subset(np_gpcr_cpm,brain_region_label=="VISp")

alltyp=133
clabel=paste("CT",c(1:alltyp),sep="")

nppmat=matrix(0,length(npgpcrm),alltyp,dimnames=list(npgpcrm,clabel))

for (i in 1:length(npgpcrm)) {
  ip1=which(names(d1)==npgpcrm[i])
  for (j in 1:alltyp) {
    ip2=which(d1[,6]==j)
    nppmat[i,j]=mean(d1[ip2,ip1],trim=0.05)
  }
}

vmat=nppmat[,visclid]
vmat_npgpcr_visp=vmat

vmat_npgpcr_visp=vmat

# log before normalization
vmat=log10(vmat+1)

for (i in 1:dim(vmat)[1])  {
  print(paste(rownames(nppmat)[i],round(max(vmat[i,]),3)))
  vmat[i,]=vmat[i,]/max(vmat[i,])
}

plot_VISp(vmat,"NP-GPCR expression in VISp",1)

colnames(vmat)=paste("CT",visdend,sep="")
write.csv(vmat,"F:\\Analysis\\Neuropeptides\\FigureData\\Figure5A.csv")

##################################
# 5C.  NPP: ALM Expression
##################################

d1=subset(np_gpcr_cpm,brain_region_label=="ALM")

alltyp=133
clabel=paste("CT",c(1:alltyp),sep="")

nppmat=matrix(0,length(nppm),alltyp,dimnames=list(nppm,clabel))

for (i in 1:length(nppm)) {
  ip1=which(names(d1)==nppm[i])
  for (j in 1:alltyp) {
    ip2=which(d1[,6]==j)
    nppmat[i,j]=mean(d1[ip2,ip1],trim=0.05)
  }
}

vmat=nppmat[,almclid]

vmat_npp_alm=vmat

# log before normalization
vmat=log10(vmat+1)

for (i in 1:dim(vmat)[1])  {
  print(paste(rownames(nppmat)[i],round(max(vmat[i,]),3)))
  vmat[i,]=vmat[i,]/max(vmat[i,])
}

plot_ALM(vmat,"NPP expression in ALM",1)

colnames(vmat)=paste("CT",almdend,sep="")
write.csv(vmat,"F:\\Analysis\\Neuropeptides\\FigureData\\Figure5C.csv")

######################################
# 5D.  NP-GPCR: ALM Expression
######################################

alltyp=133
clabel=paste("CT",c(1:alltyp),sep="")

nppmat=matrix(0,length(npgpcrm),alltyp,dimnames=list(npgpcrm,clabel))

for (i in 1:length(npgpcrm)) {
  ip1=which(names(d1)==npgpcrm[i])
  for (j in 1:alltyp) {
    ip2=which(d1[,6]==j)
    nppmat[i,j]=mean(d1[ip2,ip1],trim=0.05)
  }
}

vmat=nppmat[,almclid]
vmat_npgpcr_alm=vmat

vmat_npgpcr_alm=vmat

# log before normalization
vmat=log10(vmat+1)

for (i in 1:dim(vmat)[1])  {
  print(paste(rownames(nppmat)[i],round(max(vmat[i,]),3)))
  vmat[i,]=vmat[i,]/max(vmat[i,])
}

plot_ALM(vmat,"NP-GPCR expression in ALM",1)

colnames(vmat)=paste("CT",almdend,sep="")
write.csv(vmat,"F:\\Analysis\\Neuropeptides\\FigureData\\Figure5D.csv")

# Calculate intersection of cell types correlation - NPP
commont=intersect(colnames(vmat_npp_alm),colnames(vmat_npp_visp))
amat=as.vector(vmat_npp_alm[,commont])
bmat=as.vector(vmat_npp_visp[,commont])
plot(amat,bmat,pch=16,cex=0.5)
cor(amat,bmat)

# Calculate intersection of cell types correlation - NP-GPCR
commont=intersect(colnames(vmat_npgpcr_alm),colnames(vmat_npgpcr_visp))
amat=as.vector(vmat_npgpcr_alm[,commont])
bmat=as.vector(vmat_npgpcr_visp[,commont])

par(fig = c(0,1,0,1))
plot(log(amat+1),log(bmat+1),pch=16,cex=0.5,axes=F,xlab="ALM",ylab="VISp",main="Expression in common ALM and VISp cell types")
axis(1)
axis(2)
cor.test(amat,bmat)
amod=lm(log(bmat+1)~log(amat+1))
abline(amod$coefficients,col=2,lw=2)
rsq=summary(amod)$adj.r.squared
pval="p<2e-16"
text(2,5.75,paste("Adjusted R-squared = ",round(rsq,3)))
text(1.5,5.5,"p<2e-16")

#############################################################################################################
# # Figure 6. Expression profiles of conjugate NPP/NP-GPCR pairs predict neuropeptidergic signaling networks
#############################################################################################################

maxvec_alm=vector("numeric",dim(inpairs)[1])
maxvec_visp=vector("numeric",dim(inpairs)[1])

# assumes vat_npp_visp etc. matrices above

regionvec=c("VISp","ALM")

for (region in regionvec) {

 for (ival in 1:dim(inpairs)[1]) {

  print (paste("Printing",region,ival))

  jval = as.character(inpairs[ival,2])
  kval = as.character(inpairs[ival,3])

  if (region == "VISp") {
     outerprod=outer(vmat_npp_visp[jval,],vmat_npgpcr_visp[kval,])
     outerprod=log10(outerprod+1)
     maxvec_visp[ival]=max(outerprod)
  }

  if (region == "ALM")  {
     outerprod=outer(vmat_npp_alm[jval,],vmat_npgpcr_alm[kval,])
     outerprod=log10(outerprod+1)
     maxvec_alm[ival]=max(outerprod)
  }

  # make title
  normv=round(max(outerprod),2)
  icode=paste("(",region,", ",as.character(inpairs[ival,4]),", ",normv,")",sep="")
  inum=paste(ival,":",sep="")

  ititle=paste(inum,jval,"->",kval, "  ", icode,sep=" ")

  fdir="F:\\Analysis\\Neuropeptides\\Submission\\Interaction Plots\\"
 # fdir="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Interaction Plots/"

  fname=paste(fdir,region,"_",ival,"_",as.character(inpairs[ival,1]),".tiff",sep="")

  tiff(fname,width=1000,height=1000)

  if (region == "VISp") {plot_Interaction_VISp(outerprod,ititle,gamma=1)}
  if (region == "ALM")  {plot_Interaction_ALM(outerprod,ititle,gamma=1)}

  dev.off()

  f2dir="F:\\Analysis\\Neuropeptides\\Submission\\Interaction Matrices\\"
  #f2dir="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Interaction Matrices/"

   f2name=paste(f2dir,ival,"_",region,"_",inpairs[ival,1],".csv",sep="")
  write.table(outerprod,file=f2name,col.names=F,row.names=F,quote=F,sep=",")

 }
}

# write out maximum scale normalization
df=data.frame(cbind(as.character(inpairs[,1]),round(maxvec_alm,3),round(maxvec_visp,3)))
write.csv(df,"F:\\Analysis\\Neuropeptides\\Submission\\CognatePair_interaction_normalization.csv")
#write.csv(df,"/volumes/PHILIPS UFD/Analysis/Neuropeptides/Normalization.csv")

############################################
# Figure 6e: Pooled cell type representation
############################################

indir = "F:\\Analysis\\Neuropeptides\\Submission\\Interaction Matrices\\"
infiles=list.files(indir)

poolmat=matrix(0,12,12,dimnames=list(ctpool,ctpool))

plist_ALM=NULL
plist_VISp=NULL
ialm=0
ivisp=0

for (i in 1:length(infiles)) {

  print (paste("Printing Pooled",region,i))

  idf=read.csv(paste(indir,infiles[i],sep=""),header=F)
  imat=as.matrix(idf)

  fn1=unlist(strsplit(infiles[i],"[.]"))[1]
  ft=unlist(strsplit(fn1,"_"))
  fnum=as.integer(ft[1])
  region=as.character(ft[2])
  ipair=unlist(strsplit(as.character(ft[3]),"-"))  # construct interaction pair and read off type
  iloc=which(as.character(inpairs[,1])==as.character(ft[3]))
  itype=as.character(inpairs[iloc,4])

  for (j in 1:length(ctpool)) {
    for (k in 1:length(ctpool)) {

      if (region == "ALM")  {suml=almlist}
      if (region == "VISp") {suml=vislist}

      poolmat[j,k] = mean(imat[suml[[j]],suml[[k]]])
    }
  }

  if (region == "ALM")  {
    ialm=ialm+1
    plist_ALM[[ialm]]=poolmat
  }
  if (region == "VISp") {
    ivisp=ivisp+1
    plist_VISp[[ivisp]]=poolmat
  }

  maxv=round(max(poolmat),2)  # normalization factor

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(ctpool)
  )
  rownames(annotation_col)= ctpool

  ann_colors = list(CellType = ctcolors)

  mpal = colorRampPalette(brewer.pal(8,"PuBuGn"),bias=bval)(6)

  # construct title
  titp = paste(fnum,": ",ipair[1],"->",ipair[2], "  (",region,", ",itype,", ",maxv, ")",sep="")
  fdir ="F:\\Analysis\\Neuropeptides\\Submission\\Interaction Plots Pooled\\"
  fname=paste(fdir,region,"_",fnum,"_",ipair[1],"-",ipair[2],"_Pooled.tiff",sep="")

  tiff(fname,width=800,height=800)

  pheatmap(poolmat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=20,fontsize_col=20,fontsize=20,border_color=9,color=rev(mpal),
           main=titp,annotation_col=annotation_col,annotation_row=annotation_col,annotation_colors = ann_colors,annotation_legend=F,
           show_rownames=TRUE,show_colnames=TRUE,annotation_names_row=F,annotation_names_col=F,legend=F)

  dev.off()

}

##############################################################
#  Figure 6 (Supplmental) Clustering of interactions matrices
##############################################################

# make distance matrix between interaction matrices

fpath="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Interaction Matrices/"
fpath="F:\\Analysis\\Neuropeptides\\Interaction Matrices\\"

files=list.files(fpath)

matlistALM=NULL
matlistVISp=NULL
macount=0
mvcount=0
nameALM=vector("character",37)
nameVISp=vector("character",37)

corALM=matrix(0,37,37,dimnames=list(inpairs[,1],inpairs[,1]))
corVISp=matrix(0,37,37,dimnames=list(inpairs[,1],inpairs[,1]))

for (i in 1:length(files)) {

  ireg=unlist(strsplit(unlist(strsplit(files[i],"-"))[1],"_"))[2]
  inpp=unlist(strsplit(unlist(strsplit(files[i],"-"))[1],"_"))[3]
  igpcr=unlist(strsplit(unlist(strsplit(files[i],"-"))[2],"[.]"))[1]
  ipos=which ((as.character(inpairs[,2])==inpp) & (as.character(inpairs[,3])==igpcr))
  icode=as.character(inpairs[ipos,4])
  ival=paste(inpp,igpcr,sep="-")

  if (ireg=="ALM")  {
    macount=macount+1
    matlistALM[[macount]]=as.matrix(read.csv(paste(fpath,files[i],sep=""),header=F))
    nameALM[macount]=ival
  }
  if (ireg=="VISp")  {
    mvcount=mvcount+1
    matlistVISp[[mvcount]]=as.matrix(read.csv(paste(fpath,files[i],sep=""),header=F))
    nameVISp[mvcount]=ival
  }
}

for (i in 1:macount)  {
  for (j in i:macount) {
    corALM[nameALM[i],nameALM[j]]=cor(as.vector(matlistALM[[i]]),as.vector(matlistALM[[j]]))
  }
}

for (i in 1:macount)  {
  for (j in i:macount) {
    corALM[j,i]=corALM[i,j]
    corALM[i,i]=0.0
  }
}

imname="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/ALM_interactions.tiff"
tiff(imname,width=1500,height=1500)
superheat(X=corALM,row.dendrogram=T,col.dendrogram=T,bottom.label.text.angle=90,left.label.text.size=6,
          legend.text.size=16,bottom.label.text.size=6,title="ALM interactions",title.size=14)
dev.off()

for (i in 1:mvcount)  {
  for (j in i:mvcount) {
    corVISp[nameVISp[i],nameVISp[j]]=cor(as.vector(matlistVISp[[i]]),as.vector(matlistVISp[[j]]))
  }
}

for (i in 1:mvcount)  {
  for (j in i:mvcount) {
    corVISp[j,i]=corVISp[i,j]
    corVISp[i,i]=0.0
  }
}

imname="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/VISp_interactions.tiff"
tiff(imname,width=1500,height=1500)
superheat(X=corVISp,row.dendrogram=T,col.dendrogram=T,bottom.label.text.angle=90,left.label.text.size=6,
          legend.text.size=16,bottom.label.text.size=6,title="VISp interactions",title.size=14)
dev.off()

s=svd(corALM)
eigval=s$d
alm_var=cumsum(eigval*eigval)/sum(eigval*eigval)
barplot(eigval*eigval,main="ALM ")

s=svd(corVISp)
eigval=s$d
visp_var=cumsum(eigval*eigval)/sum(eigval*eigval)

###################################################################################
# Figure 6 (Suppplemental): localization of interaction matrices to major cell types
###################################################################################

fpath="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Interaction Matrices/"
fpath="F:\\Analysis\\Neuropeptides\\Submission\\Interaction Matrices\\"

files=list.files(fpath)

locMat=matrix(0,37,2)
colnames(locMat)=c("ALM","VISp")
rownames(locMat)=inpairs[,1]

for (i in 1:length(files)) {

  ireg=unlist(strsplit(unlist(strsplit(files[i],"-"))[1],"_"))[2]
  inpp=unlist(strsplit(unlist(strsplit(files[i],"-"))[1],"_"))[3]
  igpcr=unlist(strsplit(unlist(strsplit(files[i],"-"))[2],"[.]"))[1]
  ipos=which ((as.character(inpairs[,2])==inpp) & (as.character(inpairs[,3])==igpcr))
  icode=as.character(inpairs[ipos,4])
  ival=paste(inpp,igpcr,sep="-")

  fin=as.matrix(read.csv(paste(fpath,files[i],sep=""),header=F))

  vdat=as.vector(fin)
  hist(vdat,nclass=50,col=4)

  qthresh=quantile(vdat[vdat>0],probs=seq(0,1,0.1))[10]

  # pool data exceeding threshhold to major cell types

  #plot_Interaction_ALM(fin,"pre-thresh",1)

  for (j in 1:dim(fin)[1])  {
    for (k in 1:dim(fin)[2])  {
      if (fin[j,k]<qthresh)  {fin[j,k]=0.0}
    }
  }

  #plot_Interaction_ALM(fin,"post-thresh",1)

  omat=poolMat(fin,ireg)

  pfill=length(as.vector(omat[omat>0.0]))/144
  pfill2=length(as.vector(fin[fin>0.0]))*100.0/(dim(fin)[1]*dim(fin)[2])

  print(c(ireg,ival,pfill,pfill2))

  if (ireg=="ALM")  {locMat[ival,1]=round(pfill,3)*100.0}
  if (ireg=="VISp")  {locMat[ival,2]=round(pfill,3)*100.0}

}

# compute correlation of pooled interaction matrices between ALM and VISp
intercor=vector("numeric",dim(inpairs)[1])
for (i in 1:dim(inpairs)[1]) {
  intercor[i]=cor(as.vector(plist_ALM[[i]]),as.vector(plist_VISp[[i]]))
}

odat=cbind(locMat,intercor)
write.csv(odat,"F:\\Analysis\\Neuropeptides\\Submission\\Localization.csv")

mvals=apply(odats,2,max)
nodats=odats
nodats[,1]=mvals[1]-odats[,1]
nodats[,2]=mvals[2]-odats[,2]

par(las=2)
par(mar=c(7, 5, 4, 3.5) + 0.1)
odats=odat[order(odat[,3],decreasing = T),]
barplot(t(nodats[,1:2]),beside=T,horiz=F,ylab="Localization",xlab="",col=c("#fdbb84","#43a2ca"),cex.names=0.8,ylim=c(0,40),
        cex.main=2,main="Localization scores and Correlation: ALM and VISp")
legend(locator(1),legend=c("ALM","VISp"),col=c("#fdbb84","#43a2ca"),pch=15,bty="n",cex=1.5)
par(new=T)
plot(nodats[,3],axes=F,type="l",lwd=4,col=3,xlab="",ylab="")
axis(4)

#############################################################
# Interaction Classes with I,S,Q variables
#############################################################

# read in files by region maintaining counts exceeeding threshold by galpha (Q, I, S) type

fpath="F:\\Analysis\\Neuropeptides\\Interaction Matrices\\"
fpath="/volumes/PHILIPS UFD/Analysis/Neuropeptides/Submission/Interaction Matrices/"

files=list.files(fpath)

Smat_ALM=matrix(0,length(almclid),length(almclid))
Qmat_ALM=matrix(0,length(almclid),length(almclid))
Imat_ALM=matrix(0,length(almclid),length(almclid))

Smat_VISp=matrix(0,length(visclid),length(visclid))
Qmat_VISp=matrix(0,length(visclid),length(visclid))
Imat_VISp=matrix(0,length(visclid),length(visclid))

icnt=0; scnt=0; qcnt=0;

for (i in 1:length(files))  {

  print(paste("Computing I,S,Q",i))

  ireg=unlist(strsplit(unlist(strsplit(files[i],"-"))[1],"_"))[2]
  inpp=unlist(strsplit(unlist(strsplit(files[i],"-"))[1],"_"))[3]
  igpcr=unlist(strsplit(unlist(strsplit(files[i],"-"))[2],"[.]"))[1]
  ipos=which ((as.character(inpairs[,2])==inpp) & (as.character(inpairs[,3])==igpcr))
  icode=as.character(inpairs[ipos,4])

  fin=read.csv(paste(fpath,files[i],sep=""),header=F)

  if (ireg ==  "ALM") {
    if (icode=="S") {
      Smat_ALM=Smat_ALM+10^fin
      scnt=scnt+1
     }
    if (icode=="Q") {
      Qmat_ALM=Qmat_ALM+10^fin
      qcnt=qcnt+1
      }
    if (icode=="I") {
      Imat_ALM=Imat_ALM+10^fin
      icnt=icnt+1
    }
  }

  if (ireg ==  "VISp") {
    if (icode=="S") {
      Smat_VISp=Smat_VISp+10^fin
      scnt=scnt+1
    }
    if (icode=="Q") {
      Qmat_VISp=Qmat_VISp+10^fin
      qcnt=qcnt+1
    }
    if (icode=="I") {
      Imat_VISp=Imat_VISp+10^fin
      icnt=icnt+1
    }
  }
}

icnt=icnt/2
scnt=scnt/2
qcnt=qcnt/2

# mean signal by I,S,Q

 Imat_ALM=Imat_ALM/icnt
 Smat_ALM=Smat_ALM/scnt
 Qmat_ALM=Qmat_ALM/qcnt

 Imat_VISp=Imat_VISp/icnt
 Smat_VISp=Smat_VISp/scnt
 Qmat_VISp=Qmat_VISp/qcnt

 regionvec=c("VISp","ALM")

 if (region == "ALM") {
   nms=paste("CT",almdend, sep="")
   rownames(Imat_ALM)=nms
   colnames(Imat_ALM)=nms
   rownames(Smat_ALM)=nms
   colnames(Smat_ALM)=nms
   rownames(Qmat_ALM)=nms
   colnames(Qmat_ALM)=nms

   write.csv(log10(Imat_ALM+1),paste("F:\\Analysis\\Neuropeptides\\ISQ\\Imat_ALM.csv",sep=""))
   write.csv(log10(Smat_ALM+1),paste("F:\\Analysis\\Neuropeptides\\ISQ\\Smat_ALM.csv",sep=""))
   write.csv(log10(Qmat_ALM+1),paste("F:\\Analysis\\Neuropeptides\\ISQ\\Qmat_ALM.csv",sep=""))
 }

 if (region == "VISp") {
   nms=paste("CT",visdend, sep="")
   rownames(Imat_VISp)=nms
   colnames(Imat_VISp)=nms
   rownames(Smat_VISp)=nms
   colnames(Smat_VISp)=nms
   rownames(Qmat_VISp)=nms
   colnames(Qmat_VISp)=nms

   write.csv(log10(Imat_VISp+1),paste("F:\\Analysis\\Neuropeptides\\ISQ\\Imat_VISp.csv",sep=""))
   write.csv(log10(Smat_VISp+1),paste("F:\\Analysis\\Neuropeptides\\ISQ\\Smat_VISp.csv",sep=""))
   write.csv(log10(Qmat_VISp+1),paste("F:\\Analysis\\Neuropeptides\\ISQ\\Qmat_VISp.csv",sep=""))
}

# Full Size ISQ matrix

for (region in regionvec)  {

  if (region == "ALM") {
    Smat=log10(Smat_ALM+1)
    Qmat=log10(Qmat_ALM+1)
    Imat=log10(Imat_ALM+1)
    Cmat=matrix(0,length(almclid),length(almclid))
  }

  if (region == "VISp") {
    Smat=log10(Smat_VISp+1)
    Qmat=log10(Qmat_VISp+1)
    Imat=log10(Imat_VISp+1)
    Cmat=matrix(0,length(visclid),length(visclid))
  }

gmax=max(Imat,Smat,Qmat)
for (i in 1:dim(Cmat)[1]) {
  for (j in 1:dim(Cmat)[2]) {
   nval=Smat[i,j]+Qmat[i,j]+Imat[i,j]
    if (nval > 0) {
      Imat[i,j]=as.numeric((Imat[i,j]/max(Imat)))
      #Imat[i,j]=as.numeric(Imat[i,j]/gmax)
      Smat[i,j]=as.numeric((Smat[i,j]/max(Smat)))
      #Smat[i,j]=as.numeric(Smat[i,j]/gmax)
      Qmat[i,j]=as.numeric((Qmat[i,j]/max(Qmat)))
     # Qmat[i,j]=as.numeric(Qmat[i,j]/gmax)
      Cmat[i,j]=as.character(rgb(Imat[i,j],Smat[i,j],Qmat[i,j],alpha=1))
    }
    else (Cmat[i,j]=rgb(0.75,0.75,0.75))
  }
}

fout=paste("ISQ","_",region,sep="")
write.csv(Cmat,paste("F:\\Analysis\\Neuropeptides\\ISQ\\",fout,".csv",sep=""),row.names=F)

imout=paste(fout,".tiff",sep="")
imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",imout,sep="")
#imname=paste("/volumes/PHILIPS UFD/Analysis/Neuropeptides/ISQ/",imout,sep="")

tiff(imname,width=1500,height=1500)
  if (region=="ALM") {
    Cmat_ALM=Cmat
    plot_ISQ_ALM (Cmat)
    }
  if (region=="VISp") {
    plot_ISQ_VISp (Cmat)
    Cmat_VISp=Cmat
    }
dev.off()

if (region=="ALM") {

  ichn="ISQ_ALM_I.tiff"
  imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",ichn,sep="")
  tiff(imname,width=1500,height=1500)
  plot_channel_ALM(Imat,"I","ALM I")
  dev.off()

  ichn="ISQ_ALM_S.tiff"
  imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",ichn,sep="")
  tiff(imname,width=1500,height=1500)
  plot_channel_ALM(Smat,"S","ALM S")
  dev.off()

  ichn="ISQ__ALM_Q.tiff"
  imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",ichn,sep="")
  tiff(imname,width=1500,height=1500)
  plot_channel_ALM(Qmat,"Q","ALM Q")
  dev.off()

}

if (region=="VISp") {

  ichn="ISQ_VISp_I.tiff"
  imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",ichn,sep="")
  tiff(imname,width=1500,height=1500)
   plot_channel_VISp(Imat,"I","VISp I")
  dev.off()

  ichn="ISQ_VISp_S.tiff"
  imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",ichn,sep="")
  tiff(imname,width=1500,height=1500)
  plot_channel_VISp(Smat,"S","VISp S")
  dev.off()

  ichn="ISQ_VISp_Q.tiff"
  imname=paste("F:\\Analysis\\Neuropeptides\\ISQ\\",ichn,sep="")
  tiff(imname,width=1500,height=1500)
  plot_channel_VISp(Qmat,"Q","VISp Q")
  dev.off()
}

} # end region

#################################################################################
# ISQ matrix pooled to cell types, pool the I, S, Q matrices individually first
#################################################################################

Cmat_pool=matrix(0,length(ctcolors),length(ctcolors))

for (region in regionvec) {

  if (region=="ALM") {

    Smat_pool=poolMat(as.matrix(Smat_ALM),region)
    Qmat_pool=poolMat(as.matrix(Qmat_ALM),region)
    Imat_pool=poolMat(as.matrix(Imat_ALM),region)
    Smat_ALM_pool=log10(Smat_pool+1)
    Qmat_ALM_pool=log10(Qmat_pool+1)
    Imat_ALM_pool=log10(Imat_pool+1)

  }

  if (region=="VISp") {

    Smat_pool=poolMat(as.matrix(Smat_VISp),region)
    Qmat_pool=poolMat(as.matrix(Qmat_VISp),region)
    Imat_pool=poolMat(as.matrix(Imat_VISp),region)
    Smat_VISp_pool=log10(Smat_pool+1)
    Qmat_VISp_pool=log10(Qmat_pool+1)
    Imat_VISp_pool=log10(Imat_pool+1)
  }

  # write out pooled matrices

  write.csv(Imat_ALM_pool,paste("F:\\Analysis\\Neuropeptides\\ISQ\\Imat_ALM_pool.csv",sep=""))
  write.csv(Smat_ALM_pool,paste("F:\\Analysis\\Neuropeptides\\ISQ\\Smat_ALM_pool.csv",sep=""))
  write.csv(Qmat_ALM_pool,paste("F:\\Analysis\\Neuropeptides\\ISQ\\Qmat_ALM_pool.csv",sep=""))

  write.csv(Imat_VISp_pool,paste("F:\\Analysis\\Neuropeptides\\ISQ\\Imat_VISp_pool.csv",sep=""))
  write.csv(Smat_VISp_pool,paste("F:\\Analysis\\Neuropeptides\\ISQ\\Smat_VISp_pool.csv",sep=""))
  write.csv(Qmat_VISp_pool,paste("F:\\Analysis\\Neuropeptides\\ISQ\\Qmat_VISp_pool.csv",sep=""))

  if (region=="ALM")  {
    mpal = colorRampPalette(c(rgb(0,0,0),rgb(1,0,0)),bias=1)(6)
    pheatmap(Imat_ALM_pool,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
             main="ALM Pooled I",show_rownames=FALSE,show_colnames=FALSE,legend=F)
    mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,1,0)),bias=1)(6)
    pheatmap(Smat_ALM_pool,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
             main="ALM Pooled S",show_rownames=FALSE,show_colnames=FALSE,legend=F)
    mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,0,1)),bias=1)(6)
    pheatmap(Qmat_ALM_pool,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
             main="ALM Pooled Q",show_rownames=FALSE,show_colnames=FALSE,legend=F)
  }

  if (region=="VISp")  {
    mpal = colorRampPalette(c(rgb(0,0,0),rgb(1,0,0)),bias=1)(6)
    pheatmap(Imat_VISp_pool,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
             main="VISp Pooled I",show_rownames=FALSE,show_colnames=FALSE,legend=F)
    mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,1,0)),bias=1)(6)
    pheatmap(Smat_VISp_pool,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
             main="VISp Pooled S",show_rownames=FALSE,show_colnames=FALSE,legend=F)
    mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,0,1)),bias=1)(6)
    pheatmap(Qmat_VISp_pool,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
             main="VISp Pooled Q",show_rownames=FALSE,show_colnames=FALSE,legend=F)
  }

  for (i in 1:dim(Cmat_pool)[1]) {
    for (j in 1:dim(Cmat_pool)[2]) {
     # nval=Smat_pool[i,j]+Qmat_pool[i,j]+Imat_pool[i,j]
      if (nval > 0) {

        if (region == "ALM") {
          Imat_pool[i,j]=as.numeric((Imat_ALM_pool[i,j]/max(Imat_ALM_pool)))
          Smat_pool[i,j]=as.numeric((Smat_ALM_pool[i,j]/max(Smat_ALM_pool)))
          Qmat_pool[i,j]=as.numeric((Qmat_ALM_pool[i,j]/max(Qmat_ALM_pool)))
        }
        if (region == "VISp") {
          Imat_pool[i,j]=as.numeric((Imat_VISp_pool[i,j]/max(Imat_VISp_pool)))
          Smat_pool[i,j]=as.numeric((Smat_VISp_pool[i,j]/max(Smat_VISp_pool)))
          Qmat_pool[i,j]=as.numeric((Qmat_VISp_pool[i,j]/max(Qmat_VISp_pool)))
        }
        Cmat_pool[i,j]=as.character(rgb(Imat_pool[i,j],Smat_pool[i,j],Qmat_pool[i,j],alpha=1))
      }
      else (Cmat_pool[i,j]=rgb(0.75,0.75,0.75))
    }
  }

  # ISQ pooled visualization

  line=length(ctcolors)
  col=length(ctcolors)

  # use many little rectangles rect(xleft, ybottom, xright, ytop)
  xleft= (0:(col - 1)/col)
  ybottom=sort((0:(line - 1)/line) ,decreasing=T)
  xright= (1:col/col)
  ytop=sort((1:line/line),decreasing=T)

  par(new=F)
  plot(NULL,xlim = c(-0.2,1.2), ylim = c(-0.2,1.3),axes=F,ylab="",xlab="")
  for (i in 1:length(ctcolors)) {
    for (j in 1:length(ctcolors)) {
      rect(xleft[i],ybottom[j],xright[i],ytop[j],border = NULL , col=Cmat_pool[j,i])
    }
  }
  legend(1,1,legend=c("I","S","Q","None"),pch=15,col=c(2,3,4,rgb(0.75,0.75,0.75)),bty="n",cex=1.75)

  text(0.5,1.25,paste(region,": NPP NP-GPCR Interactions",sep=""),font=2,cex=2)

  # text and annotations

  xlt=xleft
  ybt=rep(1.0,12)
  ytt=rep(ytop[1]+2*0.08333,12)
  xrt=xright
  tposx=xlt+0.08333/2
  tposy=ybt+0.08333

  for (i in 1:length(ctcolors)) {
    for (j in 1:length(ctcolors)) {
      rect(xlt[i],ybt[j],xrt[i],ytt[j],border = NULL, col=ctcolors[i])
    }
  }
  text(tposx,tposy,ctpool,font=1,srt=90)

  xls= rep(-2*0.08333,12)
  xrs=rep(0,12)
  yts=ytop
  ybs=ybottom

  tposx= -0.08333
  tposy=ybs+0.08333/2

  for (i in 1:length(ctcolors)) {
    for (j in 1:length(ctcolors)) {
      rect(xls[i],ybs[j],xrs[i],yts[j],border = NULL, col=ctcolors[j])
    }
  }
  text(tposx,tposy,ctpool,font=1,srt=0)

}
#####################
# Plotting functions
#####################

matMax <- function(mtx)
{
  colmn <- which(mtx == max(mtx)) %/% nrow(mtx) + 1
  row <- which(mtx == max(mtx)) %% nrow(mtx)
  return( matrix(c(row, colmn), 1))
}

# helper function for pooling

poolMat<-function(inmat,reg) {

  poolmat=matrix(0,length(ctpool),length(ctpool),dimnames=list(ctpool,ctpool))

  for (j in 1:length(ctpool)) {
    for (k in 1:length(ctpool)) {

      if (reg == "ALM")  {suml=almlist}
      if (reg == "VISp") {suml=vislist}

      poolmat[j,k] = mean(inmat[suml[[j]],suml[[k]]])
    }
  }

  return (poolmat)

}

plot_VISp<-function(datamat,titin,bval)  {

  dendid=visclust[,1]
  clist=as.character(visclust[,4])

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(paste("CT",visdend,sep=""))
  )
  rownames(annotation_col)=paste("CT",visdend,sep="")

  names(clist)=paste("CT",visdend,sep="")

  ann_colors = list(CellType = clist)

  colnames(datamat)=as.character(annotation_col[,1])

  cccolors <- colorRampPalette(rev(brewer.pal(n = 7,name = "RdYlBu")),bias=bval)(10)

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize=20,fontsize_col=7,fontsize_row=7,border_color=9,main=titin,annotation_col=annotation_col,
           annotation_colors = ann_colors,show_colnames=F,annotation_legend=F,color=cccolors,legend=FALSE)

  return()

}

plot_ALM<-function(datamat,titin,bval)  {

  dendid=almclust[,1]
  clist=as.character(almclust[,4])

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(paste("CT",almdend,sep=""))
  )
  rownames(annotation_col)=paste("CT",almdend,sep="")

  names(clist)=paste("CT",almdend,sep="")

  ann_colors = list(CellType = clist)

  colnames(datamat)=as.character(annotation_col[,1])

  # For a heatmap from green to red (grid of 128 colors here)
  cccolors <- colorRampPalette(rev(brewer.pal(n = 7,name = "RdYlBu")),bias=bval)(10)

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_col=7,fontsize_row=10,border_color=9,main=titin,annotation_col=annotation_col,
           annotation_colors = ann_colors,show_colnames=F,annotation_legend=F,color=cccolors)

  return()

}

plot_All<-function(datamat,titin,bval)  {

  dendid=allclust[,1]
  clist=as.character(allclust[,4])

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(paste("CT",alldend,sep=""))
  )
  rownames(annotation_col)=paste("CT",alldend,sep="")

  names(clist)=paste("CT",alldend,sep="")

  ann_colors = list(CellType = clist)

  colnames(datamat)=as.character(annotation_col[,1])

  # For a heatmap from green to red (grid of 128 colors here)
  cccolors <- colorRampPalette(rev(brewer.pal(n = 7,name = "RdYlBu")),bias=bval)(100)
  #cccolors <- colorRampPalette(c("darkblue", "dodgerblue", "gray80", "orange", "orangered"),bias=bval)(100)

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_col=7,fontsize_row=10,border_color=9,main=titin,annotation_col=annotation_col,
           annotation_colors = ann_colors,show_colnames=F,annotation_legend=F,color=cccolors)

  return()

}

plot_All_pooled<-function(datamat,titin,bval)  {

  poolmat=matrix(0,dim(datamat)[1],length(ctpool),dimnames=list(rownames(datamat),ctpool))

  for (j in 1:dim(datamat)[1]) {
    for (k in 1:length(ctpool)) {
      poolmat[j,k] = mean(datamat[j,alllist[[k]]])
    }
  }

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(ctpool)
  )
  rownames(annotation_col)= ctpool

  ann_colors = list(CellType = ctcolors)

  # For a heatmap from green to red (grid of 128 colors here)
  cccolors <- colorRampPalette(rev(brewer.pal(n = 7,name = "RdYlBu")),bias=bval)(100)
  #cccolors <- colorRampPalette(c("darkblue", "dodgerblue", "gray80", "orange", "orangered"),bias=bval)(100)

   # imname=paste("/volumes/PHILIPS UFD/Analysis/Neuropeptides/",titin,".png",sep="")
  #  png(imname,width=800,height=500)
      pheatmap(poolmat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_col=28,fontsize_row=28,fontsize=24,border_color=9,main=titin,annotation_col=annotation_col,
           annotation_colors = ann_colors,show_colnames=T,annotation_legend=F,color=cccolors)
   # dev.off()

  return()

}

plot_Interaction_ALM<-function(datamat,titin, gamma)  {

  rownames(datamat)=paste("CT",almdend,sep="")
  colnames(datamat)=paste("CT",almdend,sep="")

  # includes modification for adding two horizontal and vertical lines for alignment with VISp

    dendid=almclust[,1]
    almclid=1:84

    # now fix the annotations

    dendid=almclust[,1]
    clist=as.character(almclust[,4])
    names(clist)=paste("CT",almdend,sep="")

    cvec=NULL
    for (i in 1:12) {
      cvec=c(cvec,rep(i,length(almlist[[i]])))
    }

    ctvec=ctcolors
    names(ctvec)=c(1:12)

    # Generate annotations for rows and columns
    annotation_col = data.frame(
      CellType = factor(paste("CT",almdend,sep="")),
      CellClass = cvec
    )
    rownames(annotation_col)=paste("CT",almdend,sep="")

    ann_colors = list(CellType = clist, CellClass = ctvec)

    clist=dendcolor[dendid]

    colnames(datamat)=as.character(annotation_col[,1])
    rownames(datamat)=as.character(annotation_col[,1])

    bval=1
    gamma=1
    mpal = colorRampPalette(brewer.pal(8,"PuBuGn"),bias=bval)(6)
    gammaC=1/gamma
    corcol=(col2rgb(mpal)/255)^gammaC
    mpal=rgb(t(corcol))

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=rev(mpal),
           main=titin,annotation_col=annotation_col,annotation_row=annotation_col,annotation_colors = ann_colors,annotation_legend=F,
           show_rownames=FALSE,show_colnames=FALSE,annotation_names_row=F,annotation_names_col=F,legend=F)

}

plot_Interaction_VISp<-function(datamat,titin,gamma)  {

  rownames(datamat)=paste("CT",visdend,sep="")
  colnames(datamat)=paste("CT",visdend,sep="")

  dendid=visclust[,1]
  clist=as.character(visclust[,4])
  names(clist)=paste("CT",visdend,sep="")

  cvec=NULL
  for (i in 1:12) {
    cvec=c(cvec,rep(i,length(vislist[[i]])))
  }

  ctvec=ctcolors
  names(ctvec)=c(1:12)

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(paste("CT",visdend,sep="")),
    CellClass = cvec
  )
  rownames(annotation_col)=paste("CT",visdend,sep="")

  ann_colors = list(CellType = clist, CellClass = ctvec)

  colnames(datamat)=as.character(annotation_col[,1])
  rownames(datamat)=as.character(annotation_col[,1])

  bval=1
  gamma=1
  mpal = colorRampPalette(brewer.pal(8,"PuBuGn"),bias=bval)(6)
  gammaC=1/gamma
  corcol=(col2rgb(mpal)/255)^gammaC
  mpal=rgb(t(corcol))

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=rev(mpal),
           main=titin,annotation_col=annotation_col,annotation_row=annotation_col,annotation_colors = ann_colors,annotation_legend=F,
           show_rownames=FALSE,show_colnames=FALSE,annotation_names_row=F,annotation_names_col=F,legend=F)

}

plot_ISQ_ALM <-function (Cmat) {

# tricolor intensity map by I,S, Q type

line=length(almclid)
col=length(almclid)

# use many little rectangles rect(xleft, ybottom, xright, ytop)
xleft= (0:(col - 1)/col)
ybottom=sort((0:(line - 1)/line) ,decreasing=T)
xright= (1:col/col)
ytop=sort((1:line/line),decreasing=T)

par(new=F)
plot(NULL,xlim = c(-0.2,1.2), ylim = c(-0.2,1.2),axes=F,ylab="",xlab="")
for (i in 1:length(almclid)) {
  for (j in 1:length(almclid)) {
    rect(xleft[i],ybottom[j],xright[i],ytop[j],border = NULL , col=Cmat[j,i])
  }
}
legend(1,1,legend=c("I","S","Q","None"),pch=15,col=c(2,3,4,rgb(0.75,0.75,0.75)),bty="n",cex=1.5)

text(0.5,1.1,"ALM: NPP NP-GPCR Interactions",font=2,cex=2)

}

plot_ISQ_VISp <-function (Cmat) {

  # tricolor intensity map by I,S, Q type

  line=length(visclid)
  col=length(visclid)

  # use many little rectangles rect(xleft, ybottom, xright, ytop)
  xleft= (0:(col - 1)/col)
  ybottom=sort((0:(line - 1)/line) ,decreasing=T)
  xright= (1:col/col)
  ytop=sort((1:line/line),decreasing=T)

  par(new=F)
  plot(NULL,xlim = c(-0.2,1.2), ylim = c(-0.2,1.2),axes=F,ylab="",xlab="")
  for (i in 1:length(visclid)) {
    for (j in 1:length(visclid)) {
      rect(xleft[i],ybottom[j],xright[i],ytop[j],border = NULL , col=Cmat[j,i])
    }
  }
  legend(1,1,legend=c("I","S","Q","None"),pch=15,col=c(2,3,4,rgb(0.75,0.75,0.75)),bty="n",cex=1.5)

  text(0.5,1.1,"VISp: NPP NP-GPCR Interactions",font=2,cex=2)

}

plot_channel_ALM<-function (datamat,chnl,ititle) {

  # take single channel data and index and render

  if (chnl=="I") {mpal = colorRampPalette(c(rgb(0,0,0),rgb(1,0,0)),bias=1)(6)}
  if (chnl=="S") {mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,1,0)),bias=1)(6)}
  if (chnl=="Q") {mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,0,1)),bias=1)(6)}

  rownames(datamat)=paste("CT",almdend,sep="")
  colnames(datamat)=paste("CT",almdend,sep="")

  # includes modification for adding two horizontal and vertical lines for alignment with VISp

  dendid=almclust[,1]
  almclid=1:84

  # now fix the annotations

  dendid=almclust[,1]
  clist=as.character(incolors[dendid,3])
  names(clist)=paste("CT",almdend,sep="")

  cvec=NULL
  for (i in 1:12) {
    cvec=c(cvec,rep(i,length(almlist[[i]])))
  }

  ctvec=ctcolors
  names(ctvec)=c(1:12)

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(paste("CT",almdend,sep="")),
    CellClass = cvec
  )
  rownames(annotation_col)=paste("CT",almdend,sep="")

  ann_colors = list(CellType = clist, CellClass = ctvec)

  clist=dendcolor[dendid]

  colnames(datamat)=as.character(annotation_col[,1])
  rownames(datamat)=as.character(annotation_col[,1])

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
           main=ititle,annotation_col=annotation_col,annotation_row=annotation_col,annotation_colors = ann_colors,annotation_legend=F,
           show_rownames=FALSE,show_colnames=FALSE,annotation_names_row=F,annotation_names_col=F,legend=F)

}

plot_channel_VISp<-function (datamat,chnl,ititle) {

  # take single channel data and index and render

  if (chnl=="I") {mpal = colorRampPalette(c(rgb(0,0,0),rgb(1,0,0)),bias=1)(6)}
  if (chnl=="S") {mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,1,0)),bias=1)(6)}
  if (chnl=="Q") {mpal = colorRampPalette(c(rgb(0,0,0),rgb(0,0,1)),bias=1)(6)}

  rownames(datamat)=paste("CT",visdend,sep="")
  colnames(datamat)=paste("CT",visdend,sep="")

  dendid=visclust[,1]
  clist=as.character(incolors[dendid,3])
  names(clist)=paste("CT",visdend,sep="")

  cvec=NULL
  for (i in 1:12) {
    cvec=c(cvec,rep(i,length(vislist[[i]])))
  }

  ctvec=ctcolors
  names(ctvec)=c(1:12)

  # Generate annotations for rows and columns
  annotation_col = data.frame(
    CellType = factor(paste("CT",visdend,sep="")),
    CellClass = cvec
  )
  rownames(annotation_col)=paste("CT",visdend,sep="")

  ann_colors = list(CellType = clist, CellClass = ctvec)

  colnames(datamat)=as.character(annotation_col[,1])
  rownames(datamat)=as.character(annotation_col[,1])

  pheatmap(datamat,cluster_cols=FALSE,cluster_rows=FALSE,fontsize_row=9,fontsize_col=11,fontsize=24,border_color=9,color=mpal,
           main=ititle,annotation_col=annotation_col,annotation_row=annotation_col,annotation_colors = ann_colors,annotation_legend=F,
           show_rownames=FALSE,show_colnames=FALSE,annotation_names_row=F,annotation_names_col=F,legend=F)

}


require(ggplot2)
require(grid)
require(gridExtra)
require(scales)

args <- commandArgs(trailingOnly=T)

red <- "red"
black <- "#333333"
fontsize <- 24
fontsize.label <- 8
fontsize.spanlabel <- 7.5
ylim <- c(15750, 16120)

convd <- function(x) {
    ns <- as.integer(strsplit(as.character(x), "/")[[1]])
    d <- ns[2]
    m <- ns[1]
    y <- ns[3]
    return(sprintf("%04d-%02d-%02d", y, m, d))
}

today <- read.csv("_n225-2016-06-20.csv", header=F, sep=",")
breaktime <- rep(NA, 11)
skip <- length(breaktime)
values <- c(today[, 3][1:31],
            breaktime,
            today[, 3][32:62])

df <- data.frame(Time=1:length(values), Price=values)

g <- ggplot(df, aes(x=Time, y=Price)) +
    geom_line(size=1.1) +
    ylab("Nikkei 225 [JPY]") +
　　　　xlab("Time [JST]") +
    coord_cartesian(ylim=ylim) +
    scale_x_continuous(breaks=seq(1, 84, by=12),
                       labels=c("9:00",
                                "10:00",
                                "11:00",
                                "12:00",
                                "13:00",
                                "14:00",
                                "15:00"),
                       minor_breaks=NULL) +
    theme(text=element_text(size=fontsize),
          axis.text.x=element_text(size=fontsize, colour=black),
          axis.title.x=element_text(size=fontsize, margin=margin(15, 0, 0, 0)),
          axis.text.y=element_text(size=fontsize, colour=black),
          axis.title.y=element_text(size=fontsize, margin=margin(0, 15, 0, 0)),
          plot.title=element_text(hjust=0.5, margin=margin(0, 0, 15, 0)))

arrow.thickness <- 0.7
arrow.size <- unit(0.3, "cm")
arrow.y <- 16020

g <- g +
    geom_segment(aes(x=1, y=arrow.y, xend=31, yend=arrow.y),
                 colour=red,
                 size=arrow.thickness,
                 arrow=arrow(ends="both", length=arrow.size)) +
    geom_segment(aes(x=(31 +skip), y=arrow.y, xend=length(values), yend=arrow.y),
                 colour=red,
                 size=arrow.thickness,
                 arrow=arrow(ends="both", length=arrow.size))

    y <- 16050

    labelpoint <- data.frame(Time=16, Price=y)
    colnames(labelpoint) <- c("Time", "Price")
    g <- g +
        geom_text(data=labelpoint,
                  aes(x=Time, y=Price, label="2016-08-04 Morning"),
                  vjust=1,
                  size=fontsize.spanlabel)
    labelpoint <- data.frame(Time=((31 + skip + length(values))/2), Price=y)
    colnames(labelpoint) <- c("Time", "Price")
    g <- g +
        geom_text(data=labelpoint,
                  aes(x=Time, y=Price, label="2016-08-04 Afternoon"),
                  vjust=1,
                  size=fontsize.spanlabel)

cairo_pdf("graph-n225.pdf", width=12, family=args[1])
plot(g)
dev.off()


library(dplyr)

args <- commandArgs(trailingOnly = TRUE)
t <- data.frame()
for (arg in args) {
	a <- strsplit(sub(".log", "", basename(arg)), "\\.")
	a <- a[[1]]
	server = a[[1]]
	articles = as.numeric(sub("a$", "", a[[2]]))
	target = as.numeric(sub("t$", "", a[[3]]))
	read_perc = as.numeric(sub("r$", "", a[[4]]))
	skew = a[[5]]

	con <- file(arg, open = "r")
	cpu = list()
	actual = 0
	clients = 0
	in_results = TRUE
	ts <- data.frame()
	while (length(line <- readLines(con, n = 1, warn = FALSE)) > 0) {
		if (grepl("load average", line)) {
			l <- strsplit(line, " ")
			l <- l[[1]]
			cpu = append(cpu, list(as.numeric(sub(",", "", l[[12]]))))

		} else if (startsWith(line, "# ")) {
			if (startsWith(line, "# actual ops")) {
				actual = actual + as.numeric(sub("# actual ops/s: ", "", line))
				clients = clients + 1
				in_results = TRUE
			} else if (startsWith(line, "# server stats")) {
				in_results = FALSE
			}
		} else if (in_results) {
			v <- read.table(text = line)
			this <- data.frame(op=v[,1], pct=as.factor(v[,2]), sjrn=as.numeric(v[,3]), rmt=as.numeric(v[,4]))
			ts <- rbind(ts, this)
		}
	}

	ts <- ts %>% group_by(op, pct) %>% summarize(sjrn_max = max(sjrn),
						     sjrn_min = min(sjrn),
						     sjrn = median(sjrn),
						     rmt_max = max(rmt),
						     rmt_min = min(rmt),
						     rmt = median(rmt))

	ts$server = server
	ts$articles = articles
	ts$target = target
	ts$actual = actual
	ts$readp = read_perc
	ts$skew = skew
	cpu <- unlist(cpu)
	ts$cpu = median(cpu)
	ts$cpu_min = min(cpu)
	ts$cpu_max = max(cpu)

	# expected batch size when batch time 1ms
	# ops/s = (target / clients)
	# s/batch = 0.001
	# ops/batch = target * 0.001 / clients
	# let's then compute the processing time normalized to per op
	# rmt = s/batch, want s/op, so /= ops/batch => *= batch/ops
	ts$rmt_norm = (ts$rmt * clients * 1000.0) / target

	ts <- as.data.frame(ts)

	t <- rbind(t, ts)
	close(con)
}
#t
t = t[t$pct != 100,]
t = t[t$pct != 99,]
t$server <- as.factor(t$server)
t$actual <- t$actual/1000000.0
t$target <- t$target/1000000.0
t$rmt <- t$rmt/1000.0
t$rmt_min <- t$rmt_min/1000.0
t$rmt_max <- t$rmt_max/1000.0
t$sjrn <- t$sjrn/1000.0
t$sjrn_min <- t$sjrn_min/1000.0
t$sjrn_max <- t$sjrn_max/1000.0
mx_rmt = max(t[t$pct == 50,]$rmt)
mx_rmt_norm = max(t[t$pct == 50,]$rmt_norm)
t$sjrn <- pmin(t$sjrn, 10*mx_rmt) # otherwise ggplot tries to plot all the way to 100k
t$sjrn_min <- pmin(t$sjrn_min, 10*mx_rmt)
t$sjrn_max <- pmin(t$sjrn_max, 10*mx_rmt)
#t

library(ggplot2)
p <- ggplot(data=t, aes(x=target, y=rmt, color=server, linetype=pct, shape=server, ymin=rmt_min, ymax=rmt_max))
p <- p + coord_trans(x = "identity", y = "identity", limy=c(0, mx_rmt))
p <- p + facet_grid(skew ~ op)
p <- p + scale_linetype_manual(breaks=c(50,95,99), values=c("solid","dotted","dashed"))
p <- p + geom_point(size = 0.7, alpha = 0.8) + geom_errorbar(width = 0.1) + geom_line()
p <- p + xlab("target load (Mops/s)") + ylab("batch processing time (ms)") + ggtitle("Batch processing time")
ggsave('plot-batch.png',plot=p,width=10,height=4)

p <- ggplot(data=t, aes(x=target, y=rmt_norm, color=server, linetype=pct, shape=server))
#p <- p + coord_trans(x = "identity", y = "log10", limy=c(1, mx_rmt_norm))
p <- p + scale_y_log10()
p <- p + facet_grid(skew ~ op)
p <- p + scale_linetype_manual(breaks=c(50,95,99), values=c("solid","dotted","dashed"))
p <- p + geom_point(size = 0.7, alpha = 0.8) + geom_line()
p <- p + xlab("target load (Mops/s)") + ylab("op processing time (µs)") + ggtitle("Estimated per-operation latency")
ggsave('plot-op-norm.png',plot=p,width=10,height=4)

# for sojourn time, read and write should basically be the same
worst <- data.frame(t %>% group_by(target, pct, server, skew) %>% summarize(sjrn = max(sjrn), sjrn_min = max(sjrn_min), sjrn_max = max(sjrn_max)))
p <- ggplot(data=worst, aes(x=target, y=sjrn, color=server, linetype=pct, shape=server, ymin=sjrn_min, ymax=sjrn_max))
p <- p + coord_trans(x = "identity", y = "identity", limy=c(0, 1.2*mx_rmt))
p <- p + facet_wrap(~ skew)
p <- p + scale_linetype_manual(breaks=c(50,95,99), values=c("solid","dotted","dashed"))
p <- p + geom_point(size = 0.7, alpha = 0.8) + geom_errorbar(width = 0.1) + geom_line()
p <- p + xlab("target load (Mops/s)") + ylab("sojourn time (ms)") + ggtitle("Sojourn time")
ggsave('plot-sjrn.png',plot=p,width=10,height=4)

t <- t[t$pct == 50,]
t <- t[t$op == "read",]
p <- ggplot(data=t, aes(x=target, y=cpu, color=server, shape=server, ymin=cpu_min, ymax=cpu_max))
p <- p + facet_wrap(~ skew)
p <- p + geom_hline(yintercept=16)
p <- p + geom_point(size = 0.7, alpha = 0.8) + geom_errorbar(width = 0.1) + geom_line()
p <- p + xlab("target load (Mops/s)") + ylab("cpu load") + ggtitle("Server CPU load")
ggsave('plot-cpu.png',plot=p,width=10,height=4)

#library(plotly)
#p <- subplot(p, p, nrows = 2, margin = 0.1)
#htmlwidgets::saveWidget(p, "plots.html", selfcontained=F)
#browseURL("plots.html")