require("ggplot2")
require("tidyr")

results <- read.csv("results.csv",header=TRUE,quote="\"")
results$means <- rowMeans(results[, c("controls","understandability","difficulty","stress_level","aesthetics")])
results$pre_tune <- sapply(results$pre_tune, function(x) (if (x == "true") {TRUE} else {FALSE}))

head(results)

meanVGeneral <- ggplot(results, aes(x=means,y=general_gameplay,color=pre_tune, shape=first_played)) +
                geom_point(size=3) +
                scale_x_continuous(breaks=c(0,2,4,6,8,10), limits = c(0, 10)) +
                scale_y_continuous(breaks=c(0,2,4,6,8,10), limits = c(0, 10)) +
                labs(x="Mean of initial 5 aspects"
                    ,y="Overall gameplay"
                    ,color="Pre-Tune?"
                    ,shape="First version played")

ggsave(meanVGeneral, file="meanVGeneral.png")

results2 <- results
results2$pre_tune <- NULL
results2$first_played <- NULL
results2$means <- NULL
results2$general_gameplay <- NULL
results2 <- gather(results2, key="key", value="value")
print(results2)

boxes <- ggplot(results2, aes(x=key, y=value)) +
         geom_boxplot() +
         labs(x="Aspect of gameplay", y="Similarity Score") +
         ggtitle("Ratings including pre-tune")

ggsave(boxes, file="boxes.png")

results3 <- subset(results, pre_tune == TRUE)
results3$pre_tune <- NULL
results3$first_played <- NULL
results3$means <- NULL
results3$general_gameplay <- NULL
results3 <- gather(results3, key="key", value="value")
print(results3)

boxesPost <- ggplot(results3, aes(x=key, y=value)) +
         geom_boxplot() +
         labs(x="Aspect of gameplay", y="Similarity Score") +
         ggtitle("Ratings post-tune")

ggsave(boxesPost, file="boxesPost.png")


dyn.load('/Library/Java/JavaVirtualMachines/jdk1.8.0_131.jdk/Contents/Home/jre/lib/server/libjvm.dylib')

setwd("/Users/mengmengjiang/all datas/conductivity")

library(xlsx)

# reading datasets

# compare qd and conductivitys
# Gly1,18nl/min - 1.8kv; 180nl/min - 2kv;
# Gly2,18nl/min - 2kv; 180nl/min - 1.8kv;
#

k1<-read.xlsx("gly1.xlsx",sheetName="qd1-18",header=TRUE)
k2<-read.xlsx("gly1.xlsx",sheetName="qd2-20",header=TRUE)

k3<-read.xlsx("gly2.xlsx",sheetName="qd1-20",header=TRUE)
k4<-read.xlsx("gly2.xlsx",sheetName="qd2-18",header=TRUE)

#
yan<-c("red","blue","black","green3")
pcc<-c(0,1,2,5)

#error
error.bar <- function(x, y, upper, coll,lower=upper, length=0.05,...){
  if(length(x) != length(y) | length(y) !=length(lower) | length(lower) !=
     length(upper))
    stop("vectors must be same length")
  arrows(x,y+upper, x, y-lower,col=coll, angle=90, code=3, length=length, ...)
}

#
plot(k1$fv,k1$deva, col=0,xlab = expression(italic(f["v"]) (Hz)),
          ylab = expression(italic(d["d"]) (um)), mgp=c(1.1, 0, 0),tck=0.02,
               main = "", xlim = c(0,4000),ylim=c(0,60))

               mtext("Small droplets of Q-V",3,line=-1.2,font=2,cex=1)

points(k1$fv,k1$deva,col=yan[1],lty=2,pch=pcc[1],cex=0.8)
points(k2$fv,k2$deva,col=yan[2],lty=2,pch=pcc[2],cex=0.8)
points(k3$fv,k3$deva,col=yan[3],lty=2,pch=pcc[3],cex=0.8)
points(k4$fv,k4$deva,col=yan[4],lty=2,pch=pcc[4],cex=0.8)

error.bar(k1$fv,k1$deva,k1$stdd/2,col=yan[1])
error.bar(k2$fv,k2$deva,k2$stdd/2,col=yan[2])
error.bar(k3$fv,k3$deva,k3$stdd/2,col=yan[3])
error.bar(k4$fv,k4$deva,k4$stdd/2,col=yan[4])

fit1=lm(k1$deva~k1$fv)
fit2=lm(k2$deva~k2$fv)
fit3=lm(k3$deva~k3$fv)
fit4=lm(k4$deva~k4$fv)

abline(fit1,col=yan[1],lwd=1.5,lty=2)
abline(fit2,col=yan[2],lwd=1.5,lty=2)
abline(fit3,col=yan[3],lwd=1.5,lty=2)
abline(fit4,col=yan[4],lwd=1.5,lty=2)

leg<-c("Gly1:18nl/min-1.8kv","Gly1:180nl/min-2kv","Gly2:18nl/min-2kv","Gly2:180nl/min-1.8kv")

legend("topright",legend=leg,col=yan,pch=pcc,lwd=1.5,inset=.01,cex=0.8,bty="n")

inter<-c(coef(fit1)[1],coef(fit2)[1],coef(fit3)[1],coef(fit4)[1])
slope<-c(coef(fit1)[2],coef(fit2)[2],coef(fit3)[2],coef(fit4)[2])


print(paste0(Sys.time(), " --- Describers profiles (for appendix)"))

# For describer metrics, see df01.r in the cleaning scripts.
# Data for describers is "basefile" + "-describers_2.csv"

# Filter describers with dod/dob and
# those who described at least 1 syn or valid sp.

des <- df_describers[
    (ns_spp_N + syn_spp_N) >= 1 &
    !(is.na(dod.describer) | is.na(dob.describer)),
    c(
        "full.name.of.describer", "last.name",
        "dob.describer", "dod.describer", "max", "spp_N",
        "spp_per_pub_mean", "n_pubs",
        "spp_per_pub_mean_20y", "n_pubs_20y",
        "spp_per_pub_mean_5y", "n_pubs_5y",
        "n_spp_20y", "n_spp_5y"
    )
]

# missing variables:
# spp_per_pub_mean, n_pubs,
# n_spp_20y,

# n_spp_5y, pub_years
# spp_per_pub_mean_20y, n_pubs_20y,
# spp_per_pub_mean_5y, n_pubs_5y,

des$years_last_pub_death <- des$dod.describer - des$max
des$age_at_death <- des$dod.describer - des$dob.describer

mround <- function(x,base) base*round(x/base)

des$date.century <- substr(
    as.character((des$dod.describer - des$dob.describer)/2+des$dob.describer),
    1, 3
)

des[((des$dod.describer - des$dob.describer)/2+des$dob.describer) <1000]

des$date.century <- mround(as.numeric(des$date.century), 5)
des$date.century <- paste0(des$date.century, "0s")

des$check_young <- ifelse(des$age_at_death >=40, "T", "F") # young
des$check_few.spp <- ifelse(des$spp_N <= 12, "T", "F") # few spp (than median)
des$check_few.spp.pub <- ifelse(des$spp_per_pub_mean <=10, "T", "F") # few sp/pb
des$check_few.pub <- ifelse(des$n_pubs <=3, "T", "F") # few pub

table(is.na(des$check_young))
table(is.na(des$check_few.spp))
table(is.na(des$check_few.spp.pub))

des$check_few.pub.near.death <- ifelse(
    is.na(des$n_spp_20y), "T", ifelse(
    des$n_spp_20y/des$spp_N >=0.8, "F", "T")
) # few pub

summary(des$age_at_death)

des1 <- des[,
    list(
        names=paste0(full.name.of.describer, collapse="; "),
        med_age_at_death=median(as.numeric(age_at_death), na.rm=T),
        med_spp_N = median(spp_N, na.rm=T),
        med_spp_per_pub_mean = median(spp_per_pub_mean, na.rm=T),
        med_prop_20y = median(n_spp_20y/spp_N, na.rm=T)
    ),
    by = c(
        "check_young", "check_few.spp",
        "check_few.spp.pub", "check_few.pub.near.death"
    )
]

des2 <- des[, list(.N), by=c(
    "check_young", "check_few.spp",
    "check_few.spp.pub", "check_few.pub.near.death",
    "date.century"
)]

des3 <- dcast(
    des2,

    check_young + check_few.spp.pub +
    check_few.pub.near.death + check_few.spp ~ date.century,

    value.var="N"
)

des3[is.na(des3)] <- 0

des4 <- merge(
    des1, des3, by=c(
        "check_young", "check_few.spp.pub",
        "check_few.pub.near.death", "check_few.spp"
    )
)

fwrite(
    des4, paste0(dir_table_ch1, '2019-10-02-taxonomist-one-large-mono.csv'),
    row.names=F
)

# Checks
table(is.na(des$check_young))
table(is.na(des$check_few.spp.pub))
table(is.na(des$check_few.spp))
table(is.na(des$check_few.pub.near.death))

# Copy and paste into report

# Table 1

# Caption
dim(des)
dim(des[check_young == "T"])
dim(des[check_young == "T" & check_few.pub.near.death == "T"])
auth_throughout_life <- table(des[check_young=="T",]$check_few.pub.near.death)
prop.table(auth_throughout_life)*100

# First row
des[check_young == "F",
    list(
        med_age_at_death=median(age_at_death, na.rm=T),
        med_spp_N = median(as.numeric(spp_N), na.rm=T),
        med_spp_per_pub_mean = median(spp_per_pub_mean, na.rm=T),
        med_prop_20y = median(n_spp_20y/spp_N, na.rm=T),
        N = .N
    ),
by=c("check_young")]

# Second row
des[check_young == "T" & check_few.spp.pub == "F",
    list(
        med_age_at_death=as.numeric(median(age_at_death, na.rm=T)),
        med_spp_N = as.numeric(median(spp_N, na.rm=T)),
        med_spp_per_pub_mean = as.numeric(median(spp_per_pub_mean, na.rm=T)),
        med_prop_20y = as.numeric(median(n_spp_20y/spp_N, na.rm=T)),
        N = .N
    ),
    by=c("check_few.pub.near.death")
]

# Group that died young, few publications, few species, average number of species per pub
# Group that did not die young, few publications, few species, average number of species per pub
# Group that did not die young, large number of publications, large number of species, large number of species per pub
# Group that did not die young, few publications, large number of species {N and when}


training = read.csv("UCI HAR Dataset/train/X_train.txt", sep="", header=FALSE)
training[,562] = read.csv("UCI HAR Dataset/train/Y_train.txt", sep="", header=FALSE)
training[,563] = read.csv("UCI HAR Dataset/train/subject_train.txt", sep="", header=FALSE)

testing = read.csv("UCI HAR Dataset/test/X_test.txt", sep="", header=FALSE)
testing[,562] = read.csv("UCI HAR Dataset/test/Y_test.txt", sep="", header=FALSE)
testing[,563] = read.csv("UCI HAR Dataset/test/subject_test.txt", sep="", header=FALSE)

activityLabels = read.csv("UCI HAR Dataset/activity_labels.txt", sep="", header=FALSE)

# Read features and make the feature names better suited for R with some substitutions
features = read.csv("UCI HAR Dataset/features.txt", sep="", header=FALSE)
features[,2] = gsub('-mean', 'Mean', features[,2])
features[,2] = gsub('-std', 'Std', features[,2])
features[,2] = gsub('[-()]', '', features[,2])

# Merge training and test sets together
allData = rbind(training, testing)

# Get only the data on mean and std. dev.
colsWeWant <- grep(".*Mean.*|.*Std.*", features[,2])
# First reduce the features table to what we want
features <- features[colsWeWant,]
# Now add the last two columns (subject and activity)
colsWeWant <- c(colsWeWant, 562, 563)
# And remove the unwanted columns from allData
allData <- allData[,colsWeWant]
# Add the column names (features) to allData
colnames(allData) <- c(features$V2, "Activity", "Subject")
colnames(allData) <- tolower(colnames(allData))

currentActivity = 1
for (currentActivityLabel in activityLabels$V2) {
  allData$activity <- gsub(currentActivity, currentActivityLabel, allData$activity)
  currentActivity <- currentActivity + 1
}

allData$activity <- as.factor(allData$activity)
allData$subject <- as.factor(allData$subject)

tidy = aggregate(allData, by=list(activity = allData$activity, subject=allData$subject), mean)
tidy[,90] = NULL
tidy[,89] = NULL
write.table(tidy, "tidy.txt", sep="\t")


library(dplyr)
library(ggplot2)
library(tidyr)

# read in the first n_files (+1) CSV files
link = "https://github.com/gumdropsteve/datasets/raw/master/zillow/properties_2016_part_0.csv"
n_files = 4
for(n in 0:n_files){
  link = substr(link, start=1, stop=80)
  link = paste0(link, n, '.csv')
  # if it's the first file, create the dataframe
  if(n == 0){
    properties = read.csv(link)
  }else{
    # not the first file, missing column names, add it to the bottom of the dataframe
    new_properties = read.csv(link)
    colnames(new_properties) = colnames(properties)
    properties = rbind(properties, new_properties)
  }
}
properties = as_tibble(properties)
properties

# load in train data (transactions)
link <- 'https://github.com/gumdropsteve/datasets/raw/master/zillow/train_2016_v2.csv'
transactions <- read.csv(link)
transactions <- as_tibble(transactions)
transactions

# check for matches in properties and transactions data
matches = inner_join(transactions, properties, by='parcelid')

# convert all NULL values to 0
matches[is.na(matches)] = 0
matches

# load sample submissions file
sample_submissions = read.csv('https://raw.githubusercontent.com/gumdropsteve/datasets/master/zillow/sample_submission.csv')

# reference: https://www.kaggle.com/philippsp/exploratory-analysis-zillow
# rename columns so they're more understandable
properties <- properties %>% rename(
  id_parcel = parcelid,
  build_year = yearbuilt,
  area_basement = basementsqft,
  area_patio = yardbuildingsqft17,
  area_shed = yardbuildingsqft26,
  area_pool = poolsizesum,
  area_lot = lotsizesquarefeet,
  area_garage = garagetotalsqft,
  area_firstfloor_finished = finishedfloor1squarefeet,
  area_total_calc = calculatedfinishedsquarefeet,
  area_base = finishedsquarefeet6,
  area_live_finished = finishedsquarefeet12,
  area_liveperi_finished = finishedsquarefeet13,
  area_total_finished = finishedsquarefeet15,
  area_unknown = finishedsquarefeet50,
  num_unit = unitcnt,
  num_story = numberofstories,
  num_room = roomcnt,
  num_bathroom = bathroomcnt,
  num_bedroom = bedroomcnt,
  num_bathroom_calc = calculatedbathnbr,
  num_bath = fullbathcnt,
  num_75_bath = threequarterbathnbr,
  num_fireplace = fireplacecnt,
  num_pool = poolcnt,
  num_garage = garagecarcnt,
  region_county = regionidcounty,
  region_city = regionidcity,
  region_zip = regionidzip,
  region_neighbor = regionidneighborhood,
  tax_total = taxvaluedollarcnt,
  tax_building = structuretaxvaluedollarcnt,
  tax_land = landtaxvaluedollarcnt,
  tax_property = taxamount,
  tax_year = assessmentyear,
  tax_delinquency = taxdelinquencyflag,
  tax_delinquency_year = taxdelinquencyyear,
  zoning_property = propertyzoningdesc,
  zoning_landuse = propertylandusetypeid,
  zoning_landuse_county = propertycountylandusecode,
  flag_fireplace = fireplaceflag,
  flag_tub = hashottuborspa,
  quality = buildingqualitytypeid,
  framing = buildingclasstypeid,
  material = typeconstructiontypeid,
  deck = decktypeid,
  story = storytypeid,
  heating = heatingorsystemtypeid,
  aircon = airconditioningtypeid,
  architectural_style= architecturalstyletypeid
)
transactions <- transactions %>% rename(
  id_parcel = parcelid,
  date = transactiondate
)

properties <- properties %>%
  mutate(tax_delinquency = ifelse(tax_delinquency=="Y",1,0),
         flag_fireplace = ifelse(flag_fireplace=="Y",1,0),
         flag_tub = ifelse(flag_tub=="Y",1,0))

# view the renamed dataframe
View(properties)

# visualize missing values
missing_values <- properties %>% summarize_each(funs(sum(is.na(.))/n()))

missing_values <- gather(missing_values, key="feature", value="missing_pct")
missing_values %>%
  ggplot(aes(x=reorder(feature, -missing_pct), y=missing_pct)) +
  geom_bar(stat="identity",fill="red")+
  coord_flip()+theme_bw()

# when were the houses built?
properties %>%
  ggplot(aes(x=build_year))+geom_line(stat="density", color="red", size=1.2)+theme_bw()

# extract census tractnumber and block number from rawcensustractandblock column
# note: unfinished
# converting from python: https://github.com/eswar3/Zillow-prediction-models/blob/master/Step%202a-Approach1.ipynb
matches$rawcensustractandblock
matches$census_tractnumber <- substring(matches$rawcensustractandblock,
                                        first=5,
                                        last=11)
matches$block_number = substring(matches$rawcensustractandblock, first=12)
matches$block_number
matches$block_number = paste0(substring(matches$block_number, first=1, last=5), '.', substring(matches$block_number, first=6))
#df_train['block_number']=df_train['block_number'].apply(lambda x: int(round(float(x),0)) )
#df_train['block_number']=df_train['block_number'].apply(lambda x: str(x).ljust(4,'0') )


##BarBIQ_final_fitting_OD.r

#####Author#####
#Jianshi Frank Jin

#####Version#####
#V1.001
#2018.12.02

###Before running, please change the following information which labeled by "CHECK1-4".

setwd("/yourpath") ### "CHECK1" path of your data
library (plotrix)

group1 <- read.table("output_filename_step15", ## "CHECK2" your data file name
    header=T, sep="")

outputname<- "EDrops.txt" ## "CHECK3" your output file name

write.table(t(c("ID", "EDrop", "SE")),file=outputname,sep="\t",col.names = F, row.names = F, quote = F)

## ID: the index ID;
## EDrop: operational droplet (OD);
## SE: standard error.

### For the sample SX
for (i in c("S1","S2")) ## "CHECK4" Indexes you want to analysis
    {
 sample<- i
 sampleA<-paste(c(sample,"A"),collapse = "_")
 sampleB<-paste(c(sample,"B"),collapse = "_")
 sampleO<-paste(c(sample,"O"),collapse = "_")
    group2 <- group1[(group1[,sampleA]>0 & group1[,sampleB]>0), ]
    x=log10(group2[,sampleA]*group2[,sampleB])
    y=group2[,sampleO]

data <- cbind(x,y)
data <- data.frame(data)
### Calculate the median
stock<-c()
for(i in seq(from=-0.4, to=10, by=0.2))
   {
     low=i;
     up=i+0.4;
     mid=low+0.2;
     data1<-data[data$x >low, ];
     data1<-data1[data1$x <= up, ];
    #  print(nrow(data1));
            if(nrow(data1)>2)
            {
             mean<-mean(data1[,2]);
             media<-median(data1[,2]);
             stock=rbind(stock,c(mid,mean,media));
            }
   }
stock <- data.frame(stock)
colnames(stock)=c("mid","mean","media")
stock$media<-log10(stock$media)
stock$mean<-log10(stock$mean)
stock[stock == "-Inf"]<- -2

select=stock[stock$media > -2, ];
x=select$mid
y=select$media

## Fitting
model <- lm(y ~ 1 + offset(x))
print(p<-summary(model))
predicted.intervals <- predict(model,data.frame(x=x),interval='confidence',
                                level=0.99)

# EDrop <-  read.table(outputname, header=F, sep="", colClasses=c("character"))
newdata<-t(c(sample, -model$coeff,p$coefficients[,2]))
# EDrop<-rbind(EDrop,newdata)
write.table(newdata,file=outputname,sep="\t",col.names = F, row.names = F, quote = F, append = T)

    }

##end##


library(raster)
library(Matrix)
library(dplyr)
library(parallel)
options(future.globals.maxSize = 4000 * 1024^2)

labelling<- function(mat){
  tmp<-data.frame(matrix(ncol=3, nrow=0))
  colnames(tmp)<-c("x","y","name")
  for(i in (1:max(mat))){
    ind<-center_spark(mat,i)
    tmp<-rbind(tmp, c(ind[2],nrow(mat)-ind[1], i))
  }
  return(tmp)
}
affichage <- function(img_mat_fun,mat){
  res_img<-matrix(0,dim(img_mat_fun)[1],dim(img_mat_fun)[2])
  if(max(mat)!=0){
    for(i in (1:max(mat))){
      ind<-which(mat==i, arr.ind=TRUE)
      for(el in 1:nrow(ind)){
        res_img[ind[el,1],ind[el,2]]<-img_mat_fun[ind[el,1],ind[el,2]]
      }

    }
  }
  return(res_img)
}

center_spark<-function(mat_spark, sparknumber){
  ind<-which(mat_spark==sparknumber, arr.ind=TRUE)
  x<-mean(ind[,1])
  y<-mean(ind[,2])
  return(c(x,y))
}
results_dir<-paste0("results/", file_name)
if(!dir.exists(results_dir)){
  dir.create(results_dir)
}

img=raster(paste0("data/",file_name,".tif"))
img_mat=as.matrix(img)

filtre<- function(pixel){
  if (pixel<(moyenne+85)){
    return(0L)
  }else{
    return(1L)
  }
}

moyenne=mean(img_mat)
img_mat_ft=matrix(unlist(mclapply(img_mat, filtre, mc.cores=3)), nrow=dim(img_mat)[1], ncol=dim(img_mat)[2])
img_mat_ft[dim(img_mat_ft)[1],dim(img_mat_ft)[2]]=1

find_transient<- function(mat){
  transient_x_coord<-c()
  for(ix in 1:nrow(mat)){
    if(sum(mat[ix,]!=0)/ncol(mat)>0.5){
      transient_x_coord<-c(transient_x_coord,ix)
    }
  }
  transients<-c()
  for(el in transient_x_coord){
    transients<-c(transients, el:(min(el+30,nrow(mat))))
  }
  transients<-unique(transients)
  return(transients)
}

find_blanks<- function(mat){
  blanks<-c()
  for(ix in 1:nrow(mat)){
    if(sum(mat[ix,]!=0)/ncol(mat)<0.16){
      blanks<-c(blanks,ix)
    }
  }
  return(blanks)
}

transient <- find_transient(img_mat_ft)

img_mat_ft[transient,]=0
blanks<-find_blanks(img_mat_ft)
blanks<-sort(unique(c(1,nrow(img_mat_ft),blanks)))

while(max(blanks[2:length(blanks)]-blanks[1:length(blanks)-1])>200){
  ind<-which.max(blanks[2:length(blanks)]-blanks[1:length(blanks)-1])
  ind2<-which.min(rowSums(img_mat_ft[(blanks[ind]+1):(blanks[ind+1]-1),]))
  blanks<<-c(blanks,(ind2+blanks[ind]))
  blanks<<-sort(blanks)
  print((ind2+blanks[ind]))
}

analyse<-function(img_mat_ft_fun,img_mat_fun,renum2){
  img_mat_ft_fun[dim(img_mat_ft_fun)[1],dim(img_mat_ft_fun)[2]]=1
  img_mat_ft_fun <- Matrix(img_mat_ft_fun, sparse = TRUE)

  sm = summary(img_mat_ft_fun)
  d <- dist(sm, "manhattan")
  if(!(dim(as.matrix(d))[[1]]<=1 | dim(as.matrix(d))[[2]]<=1)){
    gr = cutree(hclust(d, "single"), h = 1)
    mat_sparks=sparseMatrix(i = sm[, "i"], j = sm[, "j"], x = gr)
    rm(gr)
  }else {
    mat_sparks<- Matrix(0,nrow=nrow(img_mat_ft_fun),ncol=ncol(img_mat_ft_fun), sparse = TRUE)
  }

  rm(sm)
  rm(d)

  renum=1
  for(i in (1:max(mat_sparks))){
    if(sum(mat_sparks==i)<40 ){
      mat_sparks[mat_sparks==i]=0
    }else{
      mat_sparks[mat_sparks==i]=renum
      renum=renum+1
    }
  }
  mat_sparks=as.matrix(mat_sparks)

  distance_pixel<-function(x1,y1,x2,y2){
    distance<-sqrt((x1-x2)^2+(y1-y2)^2)
    return(distance)
  }

  subspark<- function(mat, sparknumber, mat_img_fun){
    mat[mat!=sparknumber]=0
    mat[mat==sparknumber]=1
    spark<-affichage(mat_img_fun, mat)
    moy_sp=mean(spark)
    std_sp=sd(spark)
    filtre_sp<- function(pixel){
      if (pixel>(moy_sp+3*std_sp)){
        return(1L)
      }else{
        return(0L)
      }
    }
    peaks=matrix(unlist(mclapply(spark, filtre_sp, mc.cores=3)), nrow=dim(spark)[1], ncol=dim(spark)[2])
    peaks=Matrix(peaks, sparse = TRUE)
    sm = summary(peaks)
    d <<- dist(sm, "manhattan")
    if(!(dim(as.matrix(d))[[1]]<=1 | dim(as.matrix(d))[[2]]<=1)){
      gr = cutree(hclust(d, "single"), h = 1)
      res=sparseMatrix(i = sm[, "i"], j = sm[, "j"], x = gr)
      rm(gr)
    }else {
      res<- Matrix(0,nrow=nrow(peaks),ncol=ncol(peaks), sparse = TRUE)
    }

    rm(d)
    rm(sm)
    renum=1
    for(i in (1:max(res))){
      if(sum(res==i)<15 ){
        res[res==i]=0
      }else{
        res[res==i]=renum
        renum=renum+1
      }
    }
    res=as.matrix(res)
    if(max(res)==0){
      return(mat)
    }else{
      newspark_center<-list()
      for(newspark in 1:max(res)){
        newspark_center[length(newspark_center)+1]<-list(center_spark(res,newspark))
      }
      inds<-which(mat==1, arr.ind=TRUE)
      for(i in 1:nrow(inds)){
        distances<-c()
        for(newspark in 1:max(res)){
          distances<-c(distances,(distance_pixel(newspark_center[[newspark]][1],newspark_center[[newspark]][2],inds[i,1],inds[i,2])))
        }
        mat[inds[i,1],inds[i,2]]<-which(distances==min(distances), arr.ind=TRUE)
      }
      return(mat)
    }
  }

  mat_subsparks<-matrix(0,dim(mat_sparks)[1],dim(mat_sparks)[2])
  if(max(mat_sparks)!=0){
    for(spark in 1:max(mat_sparks)){
      ressub<-subspark(mat_sparks,spark,img_mat_fun)
      for(i in 1:max(ressub)){
        ind<-which(ressub==i, arr.ind=TRUE)
        renum2=renum2+1
        for(el in 1:nrow(ind)){
          mat_subsparks[ind[el,1],ind[el,2]]<-renum2

        }
      }
    }
  }

  return(list(mat_subsparks,renum2))
}

res_assemblee<-matrix(0,dim(img_mat_ft)[1],dim(img_mat_ft)[2])
if(blanks[1]!=1){
  temp<-analyse(img_mat_ft[1:blanks[1],],img_mat[1:blanks[1],],0)
  res_assemblee[1:blanks[1],]<-temp[[1]]

}else{
  temp<-c(0,0,0)
}

for(i in 1:(length(blanks)-1)){
  print(i)
  print((length(blanks)-1))
  if((blanks[i]+1)!=(blanks[i+1])){
    temp<-analyse(img_mat_ft[blanks[i]:blanks[i+1],],img_mat[blanks[i]:blanks[i+1],],temp[[2]])
    res_assemblee[blanks[i]:blanks[i+1],]<-temp[[1]]
  }
}

renum=1
for(i in (1:max(res_assemblee))){
  if(sum(res_assemblee==i)>1000 ){
    res_assemblee[res_assemblee==i]=0
  }else{
    res_assemblee[res_assemblee==i]=renum
    renum=renum+1
  }
}

# resa = raster(res_assemblee)
# extent(resa) = c(1,ncol(res_assemblee),1,nrow(res_assemblee))
# plot(resa)
# textimg_mat<-labelling(res_assemblee)
# colnames(textimg_mat)<-c("x","y","name")
# text(x = textimg_mat$x, y = textimg_mat$y, labels = textimg_mat$name,cex=0.5)

abc<-affichage(img_mat,res_assemblee)
abc[transient,]=0
if(max(res_assemblee)!=0){
  try({
    png(paste0(results_dir,"/plot.png"),height=nrow(abc)*0.3,width = ncol(abc), unit="px")
    resa=raster(abc)
    extent(resa) = c(1,ncol(abc),1,nrow(abc))
    par(mar = c(1, 1, 1, 1))
    plot(resa)
    textimg_mat<-labelling(res_assemblee)
    colnames(textimg_mat)<-c("x","y","name")
    text(x = textimg_mat$x, y = textimg_mat$y, labels = textimg_mat$name)

    dev.off()
  })
}

writeRaster(resa,paste0(results_dir,"/res_assemblee.tif"), overwrite=TRUE)
sparks_params<-as.data.frame(matrix(ncol = 15))
colnames(sparks_params)<-c("taille","duree", 'debut','fin', 'distance','Transitoire avant','Transitoire après','distance_entre_transitoire','Distance normalisée','surface','f','f0','fsurf0', 'fsurf0v2','Profile Plot')
if(max(res_assemblee)!=0){
  for(i in 1:max(res_assemblee)){
    ind<-which(res_assemblee==i, arr.ind=TRUE)
    debut<-min(ind[,1])
    fin<-max(ind[,1])
    duree<-(max(ind[,1])-min(ind[,1]))*1.88
    taille<-(max(ind[,2])-min(ind[,2]))*0.26
    x<-center_spark(res_assemblee,i)[[1]]
    tmp<-transient-x
    distance<-min(tmp[tmp>=0])*1.88
    transient_apres<-min(tmp[tmp>=0])+x
    transient_avant<-max(tmp[tmp<=0])+x
    distance_entre_transitoire<-(transient_apres-transient_avant)*1.88
    distance_norm<-distance/(transient_apres-transient_avant)
    surface<-length(which(res_assemblee==i))
    profile_plot<-c()
    all_values_of_spark<-c()
    for(i2 in 0:(max(ind[,1])-min(ind[,1]))){
      ind2<-filter(as.data.frame(ind), row==(min(ind[,1])+i2))
      tmp2<-0L
      for(i3 in ind2[,2]){
        tmp2<-tmp2+abc[(min(ind[,1])+i2),i3]
        all_values_of_spark<-c(all_values_of_spark,abc[(min(ind[,1])+i2),i3])
      }
      profile_plot<-c(profile_plot,tmp2/length(ind2[,2]))
    }
    f<-max(profile_plot[!is.nan(profile_plot)])
    f0<-min(profile_plot[!is.nan(profile_plot)])
    fsurf0<-f/f0
    fsurf0v2<-mean(sort(all_values_of_spark, decreasing = TRUE)[1:5])/mean(sort(all_values_of_spark)[1:5])
    sparks_params[i,]<-c(taille,duree,debut,fin,distance,transient_avant,transient_apres,distance_entre_transitoire,distance_norm,surface,f,f0,fsurf0,fsurf0v2, 0)
    sparks_params$'Profile Plot'[i]<-list(profile_plot)
  }
}

# plot(sparks_params$taille)
# plot(sparks_params$duree)
# plot(sparks_params$distance)
# plot(sparks_params$surface)
# plot(1:length(sparks_params$'Profile Plot'[[1]])*1.88,sparks_params$'Profile Plot'[[1]], type='b')

saveRDS(sparks_params, paste(results_dir,"/sparks_params.rds",sep=""))
saveRDS(res_assemblee, paste(results_dir,"/res_assemblee.rds", sep=""))
write.csv(x = subset(sparks_params, select=-`Profile Plot`), file = paste(results_dir, "/sparks_params.csv", sep=""))
conn<-file(paste(results_dir,"/resultats.txt", sep=""))
data_to_write<-c(
  paste("Nombre de sparks", max(res_assemblee)),
  paste("Nb sparks normalisé pour 1s et 20µm", max(res_assemblee)*1000*1.88/dim(res_assemblee)[1]*20*0.26/dim(res_assemblee)[2]),
  paste("Moyenne de la taille (µm)", mean(sparks_params$taille[!is.infinite(sparks_params$taille)])),
  paste("Moyenne de la durée (ms)", mean(sparks_params$duree[!is.infinite(sparks_params$duree)])),
  paste("Moyenne de la distance aux transients (si présent)(ms)", mean(sparks_params$distance[!is.infinite(sparks_params$distance)])),
  paste("F/F0 ", mean(sparks_params$fsurf0)),
  paste("F/F0v2 ", mean(sparks_params$fsurf0v2)),
  paste("Nb sparks dist <20 ", nrow(sparks_params %>% filter(distance < 20))),
  paste("Nb sparks dist <30 ", nrow(sparks_params %>% filter(distance < 30))),
  paste("Nb sparks dist <40 ", nrow(sparks_params %>% filter(distance < 40))),
  paste("Nb sparks dist/dist entre transitoire <0.1 ", nrow(sparks_params %>% filter((distance/distance_entre_transitoire) < 0.1))),
  paste("Nb sparks dist/dist entre transitoire <0.2 ", nrow(sparks_params %>% filter((distance/distance_entre_transitoire) < 0.2))),
  paste("Nb sparks dist/dist entre transitoire <0.3 ", nrow(sparks_params %>% filter((distance/distance_entre_transitoire) < 0.3)))
)
writeLines(data_to_write, conn)
close(conn)


library("future")
future::plan(future.batchtools::batchtools_slurm,
             template = ".batchtools.slurm.tmpl",
             label     = "sim_test_1",
             resources = list(
                job.name = "sim_test_1",
                walltime = 1,
                memory = "5G",
                ncpus  = 1,
                output   = "/work/%u/%j-%x.log",
                email  = "sagouis@pm.me"
             )
)

### Community
source("./analysis/parameters/community_v1.r")

comm <- mobsim::sim_thomas_community(100, 100000, fix_s_sim = TRUE)
comm <- sRealm::jitter_species(comm = comm, sd = 0.01)
comm <- sRealm::torusify(comm)

x0 <- y0 <- 0.45
xsize <- ysize <-  0.1

res <- mobsim::abund_rect(comm = comm, x0 = x0, y0 = y0, xsize = xsize, ysize = ysize)
saveRDS(object = res, file = "~/simRealm/data/simulations/sim_test_1.rds")


library(ggvis)

shinyServer(function(input, output, session) {
  reactive({
    mtcars %>% ggvis(~disp, ~mpg) %>%
      layer_points() %>%
      scale_numeric("x", domain = input$x_domain, nice = FALSE, clamp = TRUE) %>%
      scale_numeric("y", domain = input$y_domain, nice = FALSE, clamp = TRUE)
  }) %>%
  bind_shiny("zoom")
})


length2<-subset(length, length$STRATUM<700)

length3<-aggregate(list(FREQ=length2$FREQUENCY),by=list(YEAR=length2$YEAR,LENGTH=length2$LENGTH),FUN=sum)
grid<-expand.grid(YEAR=c(2002,2004,2006,2010,2012),LENGTH=seq(1,100,1)

LENGTH=merge(grid,length3,all=T)

 LENGTH$FREQ[is.na(LENGTH$FREQ)==T]<-0

LENGTH$PROB[LENGTH$YEAR==2012]<-LENGTH$FREQ[LENGTH$YEAR==2012]/sum(LENGTH$FREQ[LENGTH$YEAR==2012])
 LENGTH$PROB[LENGTH$YEAR==2010]<-LENGTH$FREQ[LENGTH$YEAR==2010]/sum(LENGTH$FREQ[LENGTH$YEAR==2010])
 LENGTH$PROB[LENGTH$YEAR==2006]<-LENGTH$FREQ[LENGTH$YEAR==2006]/sum(LENGTH$FREQ[LENGTH$YEAR==2006])
 LENGTH$PROB[LENGTH$YEAR==2004]<-LENGTH$FREQ[LENGTH$YEAR==2004]/sum(LENGTH$FREQ[LENGTH$YEAR==2004])
 LENGTH$PROB[LENGTH$YEAR==2002]<-LENGTH$FREQ[LENGTH$YEAR==2002]/sum(LENGTH$FREQ[LENGTH$YEAR==2002])

HL12<-HL
HL12$counts<-LENGTH$FREQ[LENGTH$YEAR==2012]
HL12$density<-LENGTH$PROB[LENGTH$YEAR==2012]
plot(HL12,col="brown",freq=F,ylab="Proportion",xlab="Fork length(cm)",main=2012,cex.lab=1.2,cex.axis=1.2,cex.main=1.5)

HL10<-HL
HL10$counts<-LENGTH$FREQ[LENGTH$YEAR==2010]
HL10$density<-LENGTH$PROB[LENGTH$YEAR==2010]
plot(HL10,col="brown",freq=F,ylab="Proportion",xlab="Fork length(cm)",main=2010,cex.lab=1.2,cex.axis=1.2,cex.main=1.5)

HL06<-HL
HL06$counts<-LENGTH$FREQ[LENGTH$YEAR==2006]
HL06$density<-LENGTH$PROB[LENGTH$YEAR==2006]
plot(HL06,col="brown",freq=F,ylab="Proportion",xlab="Fork length(cm)",main=2006,cex.lab=1.2,cex.axis=1.2,cex.main=1.5)

HL04<-HL
HL04$counts<-LENGTH$FREQ[LENGTH$YEAR==2004]
HL04$density<-LENGTH$PROB[LENGTH$YEAR==2004]
plot(HL04,col="brown",freq=F,ylab="Proportion",xlab="Fork length(cm)",main=2004,cex.lab=1.2,cex.axis=1.2,cex.main=1.5)

HL02<-HL
HL02$counts<-LENGTH$FREQ[LENGTH$YEAR==2002]
HL02$density<-LENGTH$PROB[LENGTH$YEAR==2002]
plot(HL02,col="brown",freq=F,ylab="Proportion",xlab="Fork length(cm)",main=2002,cex.lab=1.2,cex.axis=1.2,cex.main=1.5)


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

# set dataset

dataset <- "Singhal"

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

# Read in data
load(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset,"/Calcs_",dataset,".RData", sep=''))

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

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

#Streicher 350,50
#Singhal 1200,100
#quartz()

# Set title and input data
title.g <- paste(dataset," - Tox vs Sclero",sep="")
cc.g <- color_TP
df.g <- mLGL
xval.g <- mLGL$TvS
xlablab.g <- 'dGLS values'

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

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

# Set title and input data
title <- ""
cc <- color_TP
df <- mLBF
xval <- mLBF$TvS
xlablab <- '2ln(BF) values'

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

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

BF_hist

graph_combined <- ggarrange(GL_hist, BF_hist, ncol=1, nrow=2, align="v")
graph_combined

ggsave(paste(dataset,"_histo.pdf",sep=""), plot=graph_combined,width = 9, height = 7, units = "in", device = 'pdf',bg = "transparent")