library("dplyr")
library("shiny")
library("leaflet")
library("plotly")

washington_covid <- read.csv("data/washington_unemployment/crosstab_real.csv",
                             stringsAsFactors = FALSE)

claims_data <- read.csv("data/washington_unemployment/initial_claims.csv",
                        stringsAsFactors = FALSE)

claims_data$Initial.Claims <- gsub(",", "", claims_data$Initial.Claims)
claims_data$Initial.Claims <- as.numeric(claims_data$Initial.Claims)

#Converted all relevant columns from type char to type numeric
washington_covid$ADAMS <- as.numeric(washington_covid$ADAMS)
washington_covid$ASOTIN <- as.numeric(washington_covid$ASOTIN)
washington_covid$BENTON <- as.numeric(washington_covid$BENTON)
washington_covid$CHELAN <- as.numeric(washington_covid$CHELAN)
washington_covid$CLALLAM <- as.numeric(washington_covid$CLALLAM)
washington_covid$CLARK <- as.numeric(washington_covid$CLARK)
washington_covid$COLUMBIA <- as.numeric(washington_covid$COLUMBIA)
washington_covid$COWLITZ <- as.numeric(washington_covid$COWLITZ)
washington_covid$DOUGLAS <- as.numeric(washington_covid$DOUGLAS)
washington_covid$FERRY <- as.numeric(washington_covid$FERRY)
washington_covid$FRANKLIN <- as.numeric(washington_covid$FRANKLIN)
washington_covid$GARFIELD <- as.numeric(washington_covid$GARFIELD)
washington_covid$GRANT <- as.numeric(washington_covid$GRANT)
washington_covid$GRAYS.HARBOR <- as.numeric(washington_covid$GRAYS.HARBOR)
washington_covid$ISLAND <- as.numeric(washington_covid$ISLAND)
washington_covid$JEFFERSON <- as.numeric(washington_covid$JEFFERSON)
washington_covid$KING <- as.numeric(washington_covid$KING)
washington_covid$KITSAP <- as.numeric(washington_covid$KITSAP)
washington_covid$KITTITAS <- as.numeric(washington_covid$KITTITAS)
washington_covid$KLICKITAT <- as.numeric(washington_covid$KLICKITAT)
washington_covid$LEWIS <- as.numeric(washington_covid$LEWIS)
washington_covid$LINCOLN <- as.numeric(washington_covid$LINCOLN)
washington_covid$MASON <- as.numeric(washington_covid$MASON)
washington_covid$OKANOGAN <- as.numeric(washington_covid$OKANOGAN)
washington_covid$PACIFIC <- as.numeric(washington_covid$PACIFIC)
washington_covid$PEND.OREILLE <- as.numeric(washington_covid$PEND.OREILLE)
washington_covid$PIERCE <- as.numeric(washington_covid$PIERCE)
washington_covid$SAN.JUAN <- as.numeric(washington_covid$SAN.JUAN)
washington_covid$SKAGIT <- as.numeric(washington_covid$SKAGIT)
washington_covid$SKAMANIA <- as.numeric(washington_covid$SKAMANIA)
washington_covid$SNOHOMISH <- as.numeric(washington_covid$SNOHOMISH)
washington_covid$SPOKANE <- as.numeric(washington_covid$SPOKANE)
washington_covid$STEVENS <- as.numeric(washington_covid$STEVENS)
washington_covid$THURSTON <- as.numeric(washington_covid$THURSTON)
washington_covid$WAHKIAKUM <- as.numeric(washington_covid$WAHKIAKUM)
washington_covid$WALLA.WALLA <- as.numeric(washington_covid$WALLA.WALLA)
washington_covid$WASHINGTON <- as.numeric(washington_covid$WASHINGTON)
washington_covid$WHATCOM <- as.numeric(washington_covid$WHATCOM)
washington_covid$WHITMAN <- as.numeric(washington_covid$WHITMAN)
washington_covid$YAKIMA <- as.numeric(washington_covid$YAKIMA)

#theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())

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

impacted_industry <- mutate(washington_covid, Total =
                              rowSums(Filter(is.numeric, washington_covid),
                                      na.rm = TRUE))

impacted_industry <- impacted_industry %>% arrange(Industry) %>% mutate(Row = seq(1,94))
industries <- length(impacted_industry$Total)

server <- function(input, output) {
  output$plot <- renderPlotly({
    plot_data <- impacted_industry %>%
      filter(Row > input$industry_choice[1], Row < input$industry_choice[2] )
    p <- ggplot(plot_data) +
      geom_col(aes(x = Industry, y = Total, group=1)) +
      scale_y_continuous(limits = c(0, 35000)) +
      labs(
        title = "Amount of Initial Claims Per Industry",
        x = "Industry",
        y = "Initial Claims"
      ) +
      scale_x_discrete(labels=seq(1,94)) +
      theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 2))
    ggplotly(p)
    return(p)
})
}

industry_input <- sliderInput(
  inputId = "industry_choice",
  label = "Please Choose a Range of Industries (1-94), all ordered by Alphabetical Order (A-Z)",
  min = head(impacted_industry$Row, 1),
  max = industries,
  value = c(1,94)
)

washington_page <- tabPanel(
  "Washington Unemployment Data",
  titlePanel("Washington Unemployment Data"),
  sidebarLayout(
    sidebarPanel(industry_input),
    mainPanel(
      h1("Plot of Initial Claims Per Industry"),
      plotlyOutput("plot")
    )
  )
)

ui <- navbarPage(
  "Final Deliverable",
  washington_page
)

shinyApp(ui = ui, server = server)

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

claims_data$Initial.Claims <- gsub(",", "", claims_data$Initial.Claims)
claims_data$Initial.Claims <- as.numeric(claims_data$Initial.Claims)
claims_plot <- ggplot(data = claims_data, aes(x = Week, y = Initial.Claims, group=1)) +
  geom_line() +
  geom_point() +
  scale_y_continuous(limits = c(5000, 185000)) +
  labs(
    title = "Amount of Initial Claims of Unemployment Per Week",
    x = "Week of Quarantine",
    y = "Initial Claims"
  )
wa_claims_plot <- ggplotly(claims_plot)
print(wa_claims_plot)


#https://cran.r-project.org/web/packages/pals/pals.pdf
#https://cran.r-project.org/web/packages/pals/vignettes/pals_examples.html

makeDf = function(pal, group){
  return(data.frame(pal, group))
}

firstUp <- function(x) {
  substr(x, 1, 1) = toupper(substr(x, 1, 1))
  return(x)
}

palOut = '../pals'
palInfo = read.csv("pals_info.csv", stringsAsFactors = F)
colnames(palInfo)
groups = unique(palInfo$group)

for(g in 1:length(groups)){
  print(groups[g])
  these = which(palInfo$group == groups[g])
  lines = vector()
  for(r in 1:length(these)){
    hex = eval(parse(text=paste0(palInfo[these[r],1],'(n=7)')))
    hex = paste0("\'",paste(hex, collapse="\', "),"\'")
    lines = c(lines, paste0(palInfo[these[r],4],': {7:{[',hex,']}'))

  }
  lines = paste(lines, collapse = ',\n')
  cat(lines)
  cat('\n\n\n')
}

for(i in 1:nrow(palInfo)){
  outFile = paste0(palOut,'/',palInfo$jsName[i],'.png')
  png(outFile, height = 3, width = 2.75, units = 'in', res=300)
  eval(parse(text=paste0('pal.bands(',palInfo$palName[i],', n=10000, labels="")')))
  dev.off()
}

files = list.files(palOut, '.png', full.names=T)
length(files)
for(i in 1:length(files)){
  cmd = paste0('magick ',files[i],' -crop 417x25+263+403 +repage ',files[i])
  system(cmd)
}


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=''))

# Rename
mL <- mLGL
ytxt <- "dGLS"
yint <- c(0.5,-0.5)

mL <- mLBF
ytxt <- "2ln(BF)"
yint <- c(10,-10)

# Names "TvS", "AIvSA", "AIvSI", "SAvAI", "SAvSI", "SIvAI", "SIvSA", "TvS_support"

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

quartz()
# Set colors
color_h0 <- color_TP
color_h1 <- color_S

graph_general <- ggplot(data=mL) +
  geom_bar(stat = "identity", position = position_dodge()) +
  aes(x=reorder(Locus,-TvS,sum),y=TvS, color = TvS < 0, fill = TvS < 0) +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.text = element_text(size=16, color="black"),
        panel.background = element_blank(),
        text = element_text(size=20),
        legend.position = "none",
        plot.title = element_text(hjust = 0.5)) +
  scale_color_manual(values=c(color_h0,color_h1)) +
  scale_fill_manual(values=c(color_h0,color_h1))

# Customize per dataset

# only need to adjust the max limits of the graph based on the largest value
max(abs(min(mL$TvS)),abs(max(mL$TvS)))
limit <- 150
#ytic <- c(seq(-limit,limit,10),0.5,-0.5)
#ytic <- seq(-limit,limit,10)
#ytic <- c(seq(-limit,limit,50),10,-10)
ytic <- c(seq(-limit,limit,20))

graph_custom <- graph_general +
  coord_cartesian(ylim=ytic) +
  scale_y_continuous(breaks = ytic) +
  ggtitle(paste(dataset,"\nToxPoly vs. Sclero",sep="")) +
  labs(y=ytxt,x='') +
  geom_hline(yintercept=yint,color=c("black"), linetype="dashed", size=0.5)
graph_custom

# Write to file
# change axis text to 24 element texts to 30
ggsave(paste(dataset,"_BF_Bar.pdf",sep=""), plot=graph_custom,width = 9.5, height = 6, units = "in", device = 'pdf',bg = "transparent")

ggsave(paste(dataset,"_dGLS_Bar.pdf",sep=""), plot=graph_custom,width = 9.5, height = 6, units = "in", device = 'pdf',bg = "transparent")


context("Test against sklearn's calibration_curve()")

read_pydata = function(py_path) {
    ## depending on if testing one at a time or running
    ## CTRL+SHIFT+T
    if(interactive()) {
        ## interactive + local use. devtools::test() interactively
        if (Sys.getenv("NOT_CRAN") == "true") {
            path = "../sklearn-compare/"
        } else {
            path = "tests/sklearn-compare/"
        }
    } else {
        path = "../sklearn-compare/"
    }
    read.csv(paste0(path, py_path))
}

py_unf_clbr = read_pydata("unf_df.csv")
py_unf_clbr = py_unf_clbr[, c(2, 1)]
py_qtl_clbr = read_pydata("qtl_df.csv")
py_qtl_clbr = py_qtl_clbr[, c(2, 1)]

data(two_class_example, package = "yardstick")

r_unf_clbr = calibration_curve(two_class_example, truth, Class1, discretise_strategy = "uniform")
r_qtl_clbr = calibration_curve(two_class_example, truth, Class1, discretise_strategy = "quantile")

expect_equal(r_unf_clbr, py_unf_clbr)
expect_equal(r_qtl_clbr, py_qtl_clbr)


library(dplyr)
options(scipen=999)

Mode <- function(x){
	ux <- unique(x)
	return(ux[which.max(tabulate(match(x, ux)))])
}

parse <- function(str){
	return(as.numeric(strsplit(str, split=",")[[1]]))
}

test = read.csv("test.csv", stringsAsFactors=FALSE)
# print(head(test))
# for(i in 1:nrow(test)){
# 	print(test$Sequence[i])
# 	print(Mode(parse(test$Sequence[i])))
# 	break
# }

# x = c(1,2,2,2)
# print(Mode(x))

test %>%
rowwise() %>%
print(Sequence) %>%
mutate(Last = Mode(parse(Sequence))) %>%
select(Id, Last) %>%
arrange(Id) %>%
write.csv(., "mode_benchmark.csv", row.names=FALSE)


library(kimisc)
library(tidyverse)
source('generalCode/estimationFunctions.r')

#if(!exists('ya')) ya <- FALSE

abvs <- c(HS='hs',Associates='cc',Bachelors='bach')

est1 <- function(edLev,des,raw=FALSE){
    abv <- if(edLev%in%names(abvs)) abvs[edLev] else 'lev'
    subsets <- list('AGEP','ageRange','raceEth','SEX',c('SEX','raceEth'))

    dat <- des$variables[,c('DEAR','attain',unique(unlist(subsets)))]
    dat$pwgtp <- des$pweights
    dat <- cbind(dat,des$repweights)
    dat[[abv]] <- dat$attain>=edLev

    if(raw){
      dat$ya <- dat$AGEP<30
      subsets <- c('DEAR','ya',subsets)
    }
    subsets <- lapply(subsets,function(sss)
      if(raw) unique(c('DEAR',sss)) else unique(c('DEAR','AGEP',sss)))

    outfun <- function(sss){
      out <- dat%>%group_by(!!! syms(sss))%>%do(x=factorProps(abv,.))
      ests <- out$x
      out$x <- NULL
      out <- bind_cols(out,do.call('bind_rows',ests))
      out <- out[,-grep('FALSE',colnames(out))]
      out <- rename(out,`I(attain >= edLev)TRUE`=`% TRUE`,se2=`TRUE SE`,Freq=n)
      out
    }

    out <- lapply(subsets, outfun)

    names(out) <- paste0(abv,c(if(raw) c('Tot','25.29','ByAge') else 'Tot',
                               'ByAgeCat','Race','Sex','RaceSex'))

    if(!raw) out[[paste0(abv,'25.29')]] <- subset(out[[paste0(abv,'Tot')]],AGEP<30)

    out
}

sampSize <- function(des){
    out <- list()
    out$bachByAge <- out$hsByAge <- xtabs(~AGEP+DEAR,des$variables,drop=TRUE)
    out$bach25.29 <- out$hs25.29 <- xtabs(~DEAR+I(AGEP<30),des$variables,drop=TRUE)
    out$bachTot <- out$hsTot <- xtabs(~DEAR,des$variables,drop=TRUE)
    out$bachByAgeCat <- out$hsByAgeCat <- xtabs( ~ageRange+DEAR,des$variables,drop=TRUE)

    out$bachRace <- out$hsRace <- xtabs(~raceEth+DEAR,des$variables,drop=TRUE)

    out$bachSex <- out$hsSex <- xtabs(~SEX+DEAR,des$variables,drop=TRUE)

    out$bachRaceSex <- out$hsRaceSex <- xtabs(~SEX+raceEth+DEAR,des$variables,drop=TRUE)

    out
}

yearInfo <- function(year,des){
    print(year)
    if(missing(des)) load(paste0(DIR,'design',year,'.RData'))
    des <- subset(des,AGEP>24 & AGEP<65) ## changed this to change age range
#    des <- update(des,raceEth=ifelse(raceEth%in%c('American Indian','Asian/PacIsl'),'Other',raceEth))

    levs <- c('HS','Associates','Bachelors')

    outRaw <- do.call('c',lapply(levs,est1,des=des,raw=TRUE))
    outAdj <-  do.call('c',lapply(levs,est1,des=des,raw=FALSE))
    outSS <- sampSize(des)

    rm(des);gc()

    list(outRaw=outRaw,outAdj=outAdj,outSS=outSS)
}


library(plyr)
library(ggplot2)

all_data <- data.frame(V1=integer(), V2=integer(),
                       V3=integer(), V4=integer(),
                       middlebox=character())

netfilter <- read.table("netfilter-latency.txt")
netfilter["middlebox"] <- "NetFilter"
vignat <- read.table("vignat-latency.txt")
vignat["middlebox"] <- "VigNAT"
counted_chains <- read.table("counted-chains-latency.txt")
counted_chains ["middlebox"] <- "counted-chains"
nop <- read.table("nop-latency.txt")
nop["middlebox"] <- "NOP"
unverified <- read.table("unverified-latency.txt")
unverified["middlebox"] <- "DPDK-unverified"

all_data <- rbind(all_data, netfilter)
all_data <- rbind(all_data, vignat)
all_data <- rbind(all_data, counted_chains)
all_data <- rbind(all_data, nop)
all_data <- rbind(all_data, unverified)

cbbPalette <- c("#000000", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")

pd <- position_dodge(2)

p <- ggplot(all_data, aes(x=V1/1e3, y=V3/1e3,
                          group=middlebox,
                          color=middlebox,
                          shape=middlebox)) +
     geom_point(size=3,position=pd) +
     geom_line() +
     geom_errorbar(aes(ymin=(V3-V4)/1e3, ymax=(V3+V4)/1e3), width=.01,
                   position=pd) +
     labs(title="1 way latency for ~8Kpkt/s. No churns") +
     xlab("# concurrent flows (K)") +
     ylab(bquote("1-way latency, "+mu+"s")) +
     theme_bw() +
     expand_limits(x=0,y=0) +
     coord_cartesian(ylim=c(0,25)) +
     theme( plot.margin = unit( c(0,0,0,0) , "in" ) )

ggsave(filename="latency.png")
print(p)


#'
#'@title Plot comparison of observed and model size comps averaged over time
#'
#'@param sizebins -
#'@param obs.comps -
#'@param prd.comp -
#'@param cols -
#'@param ymx -
#'@param xlab -
#'@param ylab -
#'@param pch -
#'@param lty -
#'@param lwd -
#'@param clr -
#'@param CI -
#'@param bar.width -
#'@param addToPlot -
#'
#'@export
#'@import graphics
#'
#source("plotErrorBars.V.r")
plotMeanSizeComps<-function(size.bins,
                            obs.comp,
                            prd.comp,
                            cols=NULL,
                            ymx=NULL,
                            xlab="year",
                            ylab="size mmCW",
                            pch=21,
                            lty=1,
                            lwd=1,
                            clr='black',
                            CI=0.8,
                            bar.width=1,
                            addToPlot=FALSE){
    #set columns to extract
    if (is.null(cols)){cols<-1:ncol(obs.comp)}

    #calculate means and std. dev.s by size bin
    mns.obs<-colMeans(obs.comp,na.rm=TRUE)[cols];
    std.obs<-apply(obs.comp,2,sd,na.rm=TRUE)[cols]/sqrt(length(cols));#standard errors of mean
    mns.prd<-colMeans(prd.comp,na.rm=TRUE)[cols];
    std.prd<-apply(prd.comp,2,sd,na.rm=TRUE)[cols]/sqrt(length(cols));#standard errors of mean

    if (!addToPlot){
        if (is.null(ymx)){
            ymx<-max(mns.obs+std.obs);
        }
        plot(length.bins, mns.obs,
             type="n",pch=pch,col=clr,
             ylim=c(0,ymx),
             xlab=xlab,ylab=ylab);
    }
    plotErrorBars.V(size.bins,
                    mns.obs,
                    sigma=std.obs,
                    CI=CI,
                    width=bar.width,
                    pch=pch,col=clr)
    points(size.bins,mns.obs,pch=pch,col=clr)
    lines(size.bins,mns.prd,lty=lty,lwd=lwd,col=clr)
}


i=0
while(i<=10)
{
  i=i+1
  if(i==5)
    break
  print(i)
}


paper<-F                   # output on paper (=TRUE) or screen (=FALSE)

Portrait<-F                 # graphical output orientation
include.terminal.year <- T          # plot terminal year (last assessment year +1) as well?
include.last.assess.year.recruit <- T          # plot recruits terminal year as well?

first.year<- 1974                #first year on plot, negative value means value defined by data
last.year<- 2011                 #last year on plot

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

cleanup()

if (paper) dev<-"wmf" else dev<-"screen"

Init.function()

dat<-Read.summary.data.areas(extend=include.terminal.year,read.init.function=F)
dat<-subset(dat,Year<=last.year )
if (first.year>0) dat<-subset(dat,Year>=first.year )

# Dead in numbers caused by predation
nox<-2; noy<-3;
noxy<-nox*noy

for (sp in (first.VPA:nsp)){
    sp.name<-sp.names[sp]

    newplot(dev,nox,noy,filename=paste(file.name,'_',sp.name,sep=''),Portrait=Portrait)
    par(mar=c(3,4,3,2))

    s<-subset(dat,Species.n==sp)
    for (a in (SMS.control@first.age :min(SMS.control@species.info[sp,'last-age'],5))){
       s1<-subset(s,Age==a )
       if (sum(s1$DeadM2)>0) {
         deadM2<-tapply(s1$DeadM2,list(s1$Area,s1$Year),sum)/1000
         cat("\nsp:",sp," Age:",a,"\n"); print(ftable(deadM2))
         barplot(deadM2,space=1,xlab='',ylab='millions',main=paste(sp.name,' age:',a,sep=''),ylim=c(0,max(apply(deadM2,2,sum))))
       }
    }
}

##############################
# M2 by quarter
cleanup()
nox<-2; noy<-3;
noxy<-nox*noy

dat0<-Read.summary.data(extend=include.terminal.year,read.init.function=F)
dat0<-subset(dat0,Year>=min(dat$Year) & Year<=max(dat$Year),select=c(Species,Year,Quarter,Species.n,Age,M2))
dat0$Area<-0

for (sp in (first.VPA:nsp)){
    sp.name<-sp.names[sp]
    s <-subset(dat, Species.n==sp,select=c(Area,Species,Year,Quarter,Species.n,Age,M2))
    s0<-subset(dat0,Species.n==sp,select=c(Area,Species,Year,Quarter,Species.n,Age,M2))
    for (q in (1:SMS.control@last.season)) {
       s1<-subset(s,Quarter==q )
       newplot(dev,nox,noy,filename=paste(file.name,'_',sp.name,sep=''),Portrait=Portrait)
       par(mar=c(3,4,3,2))

       for (a in (SMS.control@first.age :min(SMS.control@species.info[sp,'last-age'],5))){
           s2<-subset(s1,Age==a )
           s01<-subset(s0,Age==a & Quarter==q)
           s2<-rbind(s01,s2)

           b<-tapply(s2$M2,list(s2$Year,s2$Area),sum)
           if (sum(b,na.rm=T)>=0.01) {
            #cat("\nsp:",sp," Age:",a,"\n"); print(ftable(b))

             y<-as.numeric(dimnames(b)[[1]])
             plot(y,b[,1],main=paste(sp.name," Q:",q," Age:",a),xlab="",ylab='local M2',type='b',pch='0',lwd=1.5,ylim=c(0,max(b,na.rm=T)))
             for (aa in (2:(dim(b)[2]))) if(max(b[,aa],na.rm=T)>0.001) lines(y,b[,aa],col=aa,lwd=1.5,type='b',pch=as.character(aa-1))
          }
       }
    }
}

##############################
# sum of quarterly M2
cleanup()
nox<-2; noy<-2;
noxy<-nox*noy

dat0<-Read.summary.data(extend=include.terminal.year,read.init.function=F)
dat0<-subset(dat0,Year>=min(dat$Year) & Year<=max(dat$Year),select=c(Species,Year,Quarter,Species.n,Age,M2))
dat0$Area<-0
cleanup()
palette(rainbow(4))

for (sp in (first.VPA:nsp)){
  sp.name<-sp.names[sp]
  s <-subset(dat, Species.n==sp,select=c(Area,Species,Year,Quarter,Species.n,Age,M2))
  s0<-subset(dat0,Species.n==sp,select=c(Area,Species,Year,Quarter,Species.n,Age,M2))
  newplot(dev,nox,noy,filename=paste(file.name,'_',sp.name,sep=''),Portrait=Portrait)
  par(mar=c(3,4,3,2))

  for (a in (SMS.control@first.age :min(SMS.control@species.info[sp,'last-age'],3))){
    s2<-rbind(subset(s,Age==a ),subset(s0,Age==a))

    b<-tapply(s2$M2,list(s2$Year,s2$Area),sum)
    if (sum(b,na.rm=T)>=0.01) {
         y<-as.numeric(dimnames(b)[[1]])
         plot(y,b[,1],main=paste(sp.name," Age:",a),xlab="",ylab='local M2',type='b',pch='0',lwd=2.5,ylim=c(0,max(b,na.rm=T)))
        # for (aa in (2:(dim(b)[2]))) if(max(b[,aa],na.rm=T)>0.001) lines(y,b[,aa],col=aa,lwd=1.5,type='b',pch=as.character(aa-1))
        pchs<-c('5','6','8')
        for (aa in (2:(dim(b)[2]))) if(max(b[,aa],na.rm=T)>0.001) lines(y,b[,aa],col=c('grey','red','blue','green')[aa],lwd=2.0,type='b',pch=pchs[aa-1])

    }
  }
}


# Jinliang Yang
# purpose: calculate the GCA and SCA
# updated: 3.7.2012
# .7

#################
setwd("~/Documents/Heterosis_GWAS/pheno2011")
rawdata <- read.csv("pheno_diallel_master_raw_040612.csv")
rawdata <- subset(trait, !is.na(pop2))
# 2461 22

data2SAS <- function(input=trait, mytrait="TKW"){
  tkw <- input[, c("Farm", "pop1", "pop2", "Genotype2","Barcode",mytrait)];
  names(tkw) <- c("block","female", "male","cross","Tree","Height");
  outfile <- paste("pheno_diallel_", mytrait, "_4SAS.csv", sep="");
  write.table(tkw, outfile, row.names=FALSE, col.names=FALSE, quote=FALSE, sep=",")
}

#############################
data2SAS(input=rawdata, mytrait="KRN")
data2SAS(input=rawdata, mytrait="KC")
data2SAS(input=rawdata, mytrait="AKW")
data2SAS(input=rawdata, mytrait="TKW")
data2SAS(input=rawdata, mytrait="CD")
data2SAS(input=rawdata, mytrait="CL")
data2SAS(input=rawdata, mytrait="CW")

############################
setwd("/Users/yangjl/Documents/Heterosis_GWAS/pheno2011/temoutput")
sca1 <- read.csv("SCA_AKW_BLUP.csv")
sca2 <- read.csv("SCA_KC_BLUP.csv")
sca3 <- read.csv("SCA_KRN_BLUP.csv")
sca4 <- read.csv("SCA_TKW_BLUP.csv")
sca5 <- read.csv("SCA_CD_BLUP.csv")
sca6 <- read.csv("SCA_CW_BLUP.csv")
sca7 <- read.csv("SCA_CL_BLUP.csv")

scatot <- merge(sca1[,2:3], sca2[, 2:3], by="cross")
scatot <- merge(scatot, sca3[, 2:3], by="cross")
scatot <- merge(scatot, sca4[, 2:3], by="cross")
scatot <- merge(scatot, sca5[, 2:3], by="cross")
scatot <- merge(scatot, sca6[, 2:3], by="cross")
scatot <- merge(scatot, sca7[, 2:3], by="cross")

idx <- grep("x", scatot$cross)

SCA <- scatot[idx,]
GCA <- scatot[-idx,]

names(GCA) <- c("Genotype", "AKW", "KC", "KRN", "TKW", "CD", "CW", "CL")
names(SCA) <- c("Genotype", "AKW", "KC", "KRN", "TKW", "CD", "CW", "CL")

setwd("/Users/yangjl/Documents/Heterosis_GWAS/pheno2011/")
write.table(GCA, "cache/pheno_diallel_master_BLUP_GCA.csv", sep=",", row.names=FALSE, quote=FALSE)
write.table(SCA, "cache/pheno_diallel_master_BLUP_SCA.csv", sep=",", row.names=FALSE, quote=FALSE)


#
# getProjRaster<-function(data, res){
# 	grid<-getRegularGrid(data,res)
#
#
#
# }
#
# llon<-length(sort(unique(sp_pj$lon)))
# lon_large<-sort(rep(unique(grid$lon),length.out=llon))
# lon_table<-cbind(sort(unique(sp_pj$lon)),lon_large)
# llat<-length(sort(unique(sp_pj$lat)))
# lat_large<-sort(rep(unique(grid$lat),length.out=llat))
# lat_table<-cbind(sort(unique(sp_pj$lat)),lat_large)
#
# #  plot(lon_table[,1][1:100],type="l")
# #  lines(lon_table[,2])
# # x11()
# #  plot(lat_table[,1],type="l")
# # lines(lat_table[,2])
# # lon<-array(NA,21632)
# # lat<-array(NA,21632)
# # val<-array(NA,21632)
# # k<-1
# # for(j in 1:length(unique(grid$lat))){
# # 	for(i in 1:length(unique(grid$lon))){
# # 		lon[k]<-grid$lon[i]
# # 		lat[k]<-grid$lat[j]
# # 		dis<-(sp_pj$lon-grid$lon[i])^2+(sp_pj$lat-grid$lat[j])^2
# #
# #
# #
# # 		val[k]<-sp_pj[dis==min(dis),3]
# # 		cat(lon[k],lat[k],sp_pj$lon[dis==min(dis),],"\n")
# # 		k<-k+1
# #
# # 	}
# # }
# p<-data.frame(lon,lat,val)
#
# # for(i in 1:length(sp_pj$lon)){
# # 	lon_new<-lon_table[,2][lon_table[,1]==sp_pj$lon[i]]
# #
# # 	lat_new<-lat_table[,2][lat_table[,1]==sp_pj$lat[i]]
# # 	#out[out$lon==lon_new&out$lat==lat_new,3]<-sp_pj$val[i]
# #
# # }
# #
#
# # out2<-out
# # for(i in 1:length(out[,1])){
# # 	if(is.na(out2[,3][i])){
# # 		out2[,3][i]<-out2[,3][i-1]
# # 	}
# # }
#  names(p)<-c("lon","lat","val")
#  ggplot(p,aes(lon,lat,fill=val))+geom_raster()+scale_alpha_manual(values=c(0,1),guide="none")


setwd('/home/pc-752828/Dev/results-search-master/results-csv')

library(dplyr)
library(gridExtra)
library(grid)
library(ggplot2)
library(dplyr)
library(extrafont)
library(dplyr)
library('EnvStats')
library(gtable)

data <- read.csv(file = 'output-n.out', sep = ',', header = T)

data_f1 <- data[data['ite'] == 20 & data['target'] == 0,]
data_f2 <- data[data['ite'] == 20 & data['target'] == 1,]
data_f3 <- data[data['ite'] == 20 & data['target'] == 2,]
data_f4 <- data[data['ite'] == 20 & data['target'] == 6,]

nrow(data_f3)
nrow(data_f1)
nrow(unique(data_f1['name']))
nrow(unique(data_f3['name']))

unique(data_f3['name'])
data_f4a <- data_f4 %>% filter(grepl('-A', name))
data_f3a <- data_f3 %>% filter(grepl('-A', name))
data_f2a <- data_f2 %>% filter(grepl('-A', name))
data_f1a <- data_f1 %>% filter(grepl('-A', name))

data_f4b <- data_f4 %>% filter(grepl('-B', name))
data_f3b <- data_f3 %>% filter(grepl('-B', name))
data_f2b <- data_f2 %>% filter(grepl('-B', name))
data_f1b <- data_f1 %>% filter(grepl('-B', name))

data_f4c <- data_f4 %>% filter(grepl('-C', name))
data_f3c <- data_f3 %>% filter(grepl('-C', name))
data_f2c <- data_f2 %>% filter(grepl('-C', name))
data_f1c <- data_f1 %>% filter(grepl('-C', name))

value <- function(x, myname) {
  mym = mean(x)
  mysd = sd(x)
  print(mysd)
  mysqrt = sqrt(length(x))
  return(c(mn = mym, sd = mysd/mysqrt, name=myname))
}

run_plot <- function(data, title) {
  bo1 <- aggregate(x = data$best,
                   by = list(data$name),
                   FUN = function(x) return(value(x, title)))
  bo1 <- as.data.frame(as.list(bo1))
  bo1$x.mn = as.numeric(as.character(bo1$x.mn))
  bo1$x.sd = as.numeric(as.character(bo1$x.sd))
  return(bo1)
}

bo1 <- run_plot(data_f1a, "BO-6rnd-EIdef")
bo2 <- run_plot(data_f2a, "BO com Início Estratégico")
bo4 <- run_plot(data_f4a, "BO com Função de Aquisição Nova")
bo3 <- run_plot(data_f3a, "PB3Opt")
bo <- rbind(bo1, bo3)

ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  coord_cartesian(ylim=c(0,3))+
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.8, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  labs(fill = "Modo de Busca", x="Entrada A", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(.95, .95),legend.position=c(.95, .95),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8),
        legend.background = element_rect(fill=alpha('white', 0.6)))+ ggtitle('b) Zoom da Figura a')

bo1 <- run_plot(data_f1a, "BO-6rnd-EIdef")
bo2 <- run_plot(data_f2a, "BO com Início Estratégico")
bo4 <- run_plot(data_f4a, "BO com Função de Aquisição Nova")
bo3 <- run_plot(data_f3a, "PB3Opt")
bo <- rbind(bo1, bo3)

p1 <- ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  #coord_cartesian(ylim=c(1,3))+
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.8, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  labs(fill = "Modo de Busca", x="Entrada A", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(.95, .95),legend.position=c(.95, .95),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8),
        legend.background = element_rect(fill=alpha('white', 0.6)))+ ggtitle('a) Melhor Custo Encontrado')

grid.arrange(p1, p2, nrow = 1, ncol=2, top="", bottom="Carga de Trabalho",
             left="Média do Melhor Custo Normalizado")

bo1 <- run_plot(data_f1b, "BO-6rnd-EIdef")
bo2 <- run_plot(data_f2b, "BO com Início Estratégico")
bo4 <- run_plot(data_f4b, "BO com Função de Aquisição Nova")
bo3 <- run_plot(data_f3b, "PB3Opt")
bo <- rbind(bo1, bo3)

p2 <- ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.8, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  labs(fill = "Modo de Busca", x="Carga de Trabalho com Entrada B", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(.5, .5),legend.position=c(.5, .5),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8),
        legend.background = element_rect(fill=alpha('white', 0.6)))

bo1 <- run_plot(data_f1c, "BO-6rnd-EIdef")
bo2 <- run_plot(data_f2c, "BO com Início Estratégico")
bo4 <- run_plot(data_f4c, "BO com Função de Aquisição Nova")
bo3 <- run_plot(data_f3c, "PB3Opt")
bo <- rbind(bo1, bo3)

p3 <- ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.8, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  labs(fill = "Modo de Busca", x="Carga de Trabalho com Entrada C", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(.5, .5),legend.position=c(.5, .5),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8),
        legend.background = element_rect(fill=alpha('white', 0.6)))

grid.arrange(p1, p2, p3, nrow = 3, ncol=1, top="", bottom="Carga de Trabalho",
             left="Média do Melhor Custo Normalizado")

  #scale_x_continuous(minor_breaks = seq(0, 35, 0.5))+
  #scale_y_continuous(minor_breaks = seq(0, 800, 100))+ ggtitle('a) Melhor Custo Encontrado')
  #coord_cartesian(ylim=c(1,1.5))
  #theme(legend.position = "top",
  #      axis.title.x=element_blank(),
  #      axis.title.y=element_blank(),
  #      axis.text.y=element_blank(),
  #      axis.ticks.y=element_blank())
#dev.off()

bo1 <- run_plot(data_f1a, "BO com Início Aleatório")
bo2 <- run_plot(data_f2a, "BO com Início Estratégico")
bo3 <- run_plot(data_f3a, "Abordagem Proposta")
bo <- rbind(bo1, bo3)
#pdf("rplot.pdf")
p1 <- ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.4, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  theme(legend.position = "none",
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())
#  labs(fill = "Modo de Busca", x="Carga de Trabalho", y="Média do Melhor Custo Normalizado")
#dev.off()

bo1 <- run_plot(data_f1b, "BO com Início Aleatório")
bo2 <- run_plot(data_f2b, "BO com Início Estratégico")
bo3 <- run_plot(data_f3b, "Abordagem Proposta")
bo <- rbind(bo1, bo3)
#pdf("rplot.pdf")
p2 <- ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.4, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  theme(legend.position = "none",
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())
#  labs(fill = "Modo de Busca", x="none", y="none")
#dev.off()

bo1 <- run_plot(data_f1a, "BO com Início Aleatório")
bo2 <- run_plot(data_f2a, "BO com Início Estratégico")
bo3 <- run_plot(data_f3a, "Abordagem Proposta")
bo <- rbind(bo1, bo3)
p3 <- ggplot(bo, aes(x=Group.1, y=x.mn, fill = x.name))+
  geom_bar(stat="identity",  position=position_dodge(), alpha=0.7)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
  expand_limits(y = 1) +
  geom_errorbar(aes(ymin=x.mn-x.sd, ymax=x.mn+x.sd), width=0.4, alpha=.9, size=.8, position=position_dodge(.9),
                colour="orange") +
  geom_hline(yintercept=1, linetype="dashed", color = "black", size=.5)+
  theme(axis.title.x=element_blank(),
        axis.title.y=element_blank())
  #labs(fill = "Modo de Busca", x="", y="")

#legend = gtable_filter(ggplot_gtable(ggplot_build(p3)), "guide-box")

#pdf("rplot.pdf")
grid.arrange(p1, p2, p3, nrow = 3, ncol=1, top="", bottom="Carga de Trabalho",
             left="Média do Melhor Custo Normalizado")
#dev.off()


library(igraph)
library(dplyr)
library(data.table)

# turns an igraph into an edge list with community column
graphToEdgelist <- function(graph, community, k) {
  frame <- igraph::as_data_frame(graph, what = "edges")

  # sample vertex with lowest degree in the graph
  halfEdges <- c(frame$from, frame$to)
  endpoint <- data.frame(table(halfEdges))
  endpoint <-
    100 * community + as.numeric(endpoint[which.min(endpoint$Freq), 1])

  # k is the number of branches per arm
  starPoint <- ceiling(community / k)
  newEdge <-
    data.table(from = endpoint,
               to = starPoint,
               community = community)

  frame <- frame %>% mutate(from = as.numeric(from), to = as.numeric(to))
  frame <-
    frame %>% mutate(
      from = from + 100 * community %>% as.numeric(),
      to = to + 100 * community %>% as.numeric(),
      community = community %>% as.numeric()
    )
  frame <- bind_rows(frame, newEdge)

  return(frame)
}
# create the centre as edgelist with community column
starList <- function(arms) {
  frame <-
    data.table(
      from = rep(0, arms),
      to = 1:arms,
      community = rep(0, arms)
    )

  return(frame)
}

writeFinal <- function(frame, name) {
  fwrite(frame, paste0("graphs/artificial/", name, ".csv"))
}

processArtGraphstest <- function(frame, graphName) {
  frame <-
    frame %>%  mutate(
      intercommunity = ifelse(from %/% 100 == to %/% 100, TRUE, FALSE),
      intracommunity = ifelse(from %/% 100 == to %/% 100, FALSE, TRUE)
    )

  # Create the graph
  graph <-
    frame %>% select(from, to, intercommunity, intracommunity) %>% graph_from_data_frame(directed = FALSE)

  community <- as.numeric(V(graph)$name) %/% 100

  graph <- set_vertex_attr(graph, "community", value = community)
  graph <- set_vertex_attr(graph, "graphName", value = graphName)

  path <- paste0("test graphs/", graphName, ".xml")
  write_graph(graph, path, format = "graphml")

  return(graph)
}

full <- function(n, community, k = 2) {
  edgelist <-
    make_full_graph(n, directed = FALSE) %>% graphToEdgelist(community, k)
  return(edgelist)
}
bipartite <- function(m, n, community, k = 2) {
  edgelist <-
    make_full_bipartite_graph(m, n, directed = FALSE) %>% graphToEdgelist(community, k)
  return(edgelist)
}

# add item to list
addTo <- function(item, list) {
  list[[length(list) + 1]] <- item
  return(list)

}

#
#
# Test graphs
#
#

test1 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 6
  b <- 3
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <- full(10, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <- full(10, b * (arms - 1) + 2, b)    %>% addTo(branchlist)
    branchlist <- full(10, b * (arms - 1) + 3, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test1")
  processArtGraphstest(frame, "test1")
  return(frame)
}
test2 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 7
  b <- 6
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <- full(15, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <- full(15, b * (arms - 1) + 2, b)    %>% addTo(branchlist)
    branchlist <- full(15, b * (arms - 1) + 3, b)    %>% addTo(branchlist)
    branchlist <- full(15, b * (arms - 1) + 4, b)    %>% addTo(branchlist)
    branchlist <- full(15, b * (arms - 1) + 5, b)    %>% addTo(branchlist)
    branchlist <- full(15, b * (arms - 1) + 6, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test2")
  processArtGraphstest(frame, "test2")
  return(frame)
}
test3 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 8
  b <- 7
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <- bipartite(8, 3, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(8, 3, b * (arms - 1) + 2, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(8, 3, b * (arms - 1) + 3, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(18, 2, b * (arms - 1) + 4, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(18, 2, b * (arms - 1) + 5, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(18, 2, b * (arms - 1) + 6, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(18, 2, b * (arms - 1) + 7, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test3")
  processArtGraphstest(frame, "test3")

  return(frame)
}
test4 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 10
  b <- 4
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <- bipartite(10, 4, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(10, 4, b * (arms - 1) + 2, b)    %>% addTo(branchlist)
    branchlist <- full(6, b * (arms - 1) + 3, b)    %>% addTo(branchlist)
    branchlist <- full(6, b * (arms - 1) + 4, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test4")
  processArtGraphstest(frame, "test4")

  return(frame)
}
test5 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 12
  b <- 4
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <- bipartite(6, 3, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(6, 3, b * (arms - 1) + 2, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(6, 3, b * (arms - 1) + 3, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(6, 3, b * (arms - 1) + 4, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test5")
  processArtGraphstest(frame, "test5")

  return(frame)
}
test6 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 15
  b <- 6
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <-
      bipartite(10, 10, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(10, 10, b * (arms - 1) + 2, b)    %>% addTo(branchlist)
    branchlist <-
      bipartite(10, 10, b * (arms - 1) + 3, b)    %>% addTo(branchlist)
    branchlist <- full(8, b * (arms - 1) + 4, b)    %>% addTo(branchlist)
    branchlist <- full(8, b * (arms - 1) + 5, b)    %>% addTo(branchlist)
    branchlist <- full(8, b * (arms - 1) + 6, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test6")
  processArtGraphstest(frame, "test6")

  return(frame)
}
test7 <- function(void) {
  # a is the number of arms, b is the number of branches per arm
  a <- 40
  b <- 2
  star <- starList(a)

  branchlist <- list()

  for (arms in 1:a) {
    branchlist <- full(5, b * (arms - 1) + 1, b)    %>% addTo(branchlist)
    branchlist <- full(5, b * (arms - 1) + 2, b)    %>% addTo(branchlist)

  }

  frame <- rbindlist(branchlist) %>% bind_rows(star)
  frame <- frame %>% mutate(graphName = "test7")
  processArtGraphstest(frame, "test7")

  return(frame)
}

a <- test1(1)
b <- test2(1)
c <- test3(1)
e <- test4(1)
f <- test5(1)
g <- test6(1)
h <- test7(1)
#
#
#   Training graphs
#
#

art1 <- function(void) {
  star <- starList(6)
  b11 <- full(5, 1)
  b12 <- full(5, 2)
  b21 <- full(5, 3)
  b22 <- full(5, 4)
  b31 <- full(5, 5)
  b32 <- full(5, 6)
  b41 <- full(5, 7)
  b42 <- full(5, 8)
  b51 <- full(5, 9)
  b52 <- full(5, 10)
  b61 <- full(5, 11)
  b62 <- full(5, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art1")
  writeFinal(frame, "art1")
  return(frame)
}
art2 <- function(void) {
  star <- starList(6)
  b11 <- full(6, 1)
  b12 <- full(6, 2)
  b21 <- full(6, 3)
  b22 <- full(6, 4)
  b31 <- full(6, 5)
  b32 <- full(6, 6)
  b41 <- full(6, 7)
  b42 <- full(6, 8)
  b51 <- full(6, 9)
  b52 <- full(6, 10)
  b61 <- full(6, 11)
  b62 <- full(6, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art2")
  writeFinal(frame, "art2")

  return(frame)
}
art3 <- function(void) {
  star <- starList(6)
  b11 <- full(7, 1)
  b12 <- full(7, 2)
  b21 <- full(7, 3)
  b22 <- full(7, 4)
  b31 <- full(7, 5)
  b32 <- full(7, 6)
  b41 <- full(7, 7)
  b42 <- full(7, 8)
  b51 <- full(7, 9)
  b52 <- full(7, 10)
  b61 <- full(7, 11)
  b62 <- full(7, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art3")
  writeFinal(frame, "art3")
  return(frame)
}
art4 <- function(void) {
  star <- starList(6)
  b11 <- full(8, 1)
  b12 <- full(8, 2)
  b21 <- full(8, 3)
  b22 <- full(8, 4)
  b31 <- full(8, 5)
  b32 <- full(8, 6)
  b41 <- full(8, 7)
  b42 <- full(8, 8)
  b51 <- full(8, 9)
  b52 <- full(8, 10)
  b61 <- full(8, 11)
  b62 <- full(8, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art4")
  writeFinal(frame, "art4")
  return(frame)
}
art5 <- function(void) {
  star <- starList(6)
  b11 <- full(5, 1)
  b12 <- full(8, 2)
  b21 <- full(5, 3)
  b22 <- full(8, 4)
  b31 <- full(5, 5)
  b32 <- full(8, 6)
  b41 <- full(5, 7)
  b42 <- full(8, 8)
  b51 <- full(5, 9)
  b52 <- full(8, 10)
  b61 <- full(5, 11)
  b62 <- full(8, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art5")
  writeFinal(frame, "art5")
  return(frame)
}
art6 <- function(void) {
  star <- starList(6)
  b11 <- full(5, 1)
  b12 <- full(10, 2)
  b21 <- full(6, 3)
  b22 <- full(9, 4)
  b31 <- full(7, 5)
  b32 <- full(8, 6)
  b41 <- full(8, 7)
  b42 <- full(7, 8)
  b51 <- full(9, 9)
  b52 <- full(6, 10)
  b61 <- full(10, 11)
  b62 <- full(5, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art6")
  writeFinal(frame, "art6")
  return(frame)
}
art7 <- function(void) {
  star <- starList(6)
  b11 <- full(5, 1)
  b12 <- full(10, 2)
  b21 <- full(5, 3)
  b22 <- full(10, 4)
  b31 <- full(5, 5)
  b32 <- full(10, 6)
  b41 <- full(5, 7)
  b42 <- full(10, 8)
  b51 <- full(5, 9)
  b52 <- full(10, 10)
  b61 <- full(5, 11)
  b62 <- full(10, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art7")
  writeFinal(frame, "art7")
  return(frame)
}
art8 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(4, 5, 1)
  b12 <- bipartite(6, 3, 2)
  b21 <- bipartite(7, 2, 3)
  b22 <- bipartite(3, 4, 4)
  b31 <- bipartite(8, 1, 5)
  b32 <- bipartite(4, 2, 6)
  b41 <- bipartite(4, 5, 7)
  b42 <- bipartite(3, 7, 8)
  b51 <- full(6, 9)
  b52 <- full(8, 10)
  b61 <- full(5, 11)
  b62 <- full(10, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art8")
  writeFinal(frame, "art8")
  return(frame)
}
art9 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(1, 3, 1)
  b12 <- bipartite(1, 3, 2)
  b21 <- bipartite(2, 2, 3)
  b22 <- bipartite(2, 2, 4)
  b31 <- bipartite(2, 3, 5)
  b32 <- bipartite(2, 3, 6)
  b41 <- bipartite(4, 1, 7)
  b42 <- bipartite(3, 1, 8)
  b51 <- full(7, 9)
  b52 <- full(5, 10)
  b61 <- full(5, 11)
  b62 <- full(6, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art9")
  writeFinal(frame, "art9")
  return(frame)
}
art10 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(1, 6, 1)
  b12 <- bipartite(7, 2, 2)
  b21 <- bipartite(7, 2, 3)
  b22 <- bipartite(4, 3, 4)
  b31 <- bipartite(8, 1, 5)
  b32 <- bipartite(9, 1, 6)
  b41 <- bipartite(4, 2, 7)
  b42 <- bipartite(2, 2, 8)
  b51 <- full(3, 9)
  b52 <- full(11, 10)
  b61 <- full(7, 11)
  b62 <- full(5, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art10")
  writeFinal(frame, "art10")
  return(frame)
}
art11 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(1, 1, 1)
  b12 <- bipartite(7, 7, 2)
  b21 <- bipartite(2, 2, 3)
  b22 <- bipartite(6, 6, 4)
  b31 <- bipartite(3, 3, 5)
  b32 <- bipartite(5, 5, 6)
  b41 <- bipartite(4, 4, 7)
  b42 <- bipartite(4, 4, 8)
  b51 <- full(14, 9)
  b52 <- full(5, 10)
  b61 <- full(10, 11)
  b62 <- full(6, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art11")
  writeFinal(frame, "art11")
  return(frame)
}
art12 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(4, 5, 1)
  b12 <- bipartite(6, 3, 2)
  b21 <- bipartite(7, 2, 3)
  b22 <- bipartite(3, 4, 4)
  b31 <- bipartite(8, 1, 5)
  b32 <- bipartite(4, 2, 6)
  b41 <- bipartite(4, 5, 7)
  b42 <- bipartite(3, 7, 8)
  b51 <- full(6, 9)
  b52 <- full(8, 10)
  b61 <- full(5, 11)
  b62 <- full(10, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art12")
  writeFinal(frame, "art12")
  return(frame)
}
art13 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(1, 9, 1)
  b12 <- bipartite(3, 5, 2)
  b21 <- bipartite(1, 9, 3)
  b22 <- bipartite(3, 5, 4)
  b31 <- bipartite(1, 9, 5)
  b32 <- bipartite(3, 5, 6)
  b41 <- bipartite(1, 9, 7)
  b42 <- bipartite(3, 5, 8)
  b51 <- bipartite(1, 9, 9)
  b52 <- bipartite(3, 5, 10)
  b61 <- bipartite(1, 9, 11)
  b62 <- bipartite(3, 5, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art13")
  writeFinal(frame, "art13")
  return(frame)
}
art14 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(3, 7, 1)
  b12 <- bipartite(2, 4, 2)
  b21 <- bipartite(3, 7, 3)
  b22 <- bipartite(2, 4, 4)
  b31 <- bipartite(3, 7, 5)
  b32 <- bipartite(2, 4, 6)
  b41 <- bipartite(3, 7, 7)
  b42 <- bipartite(2, 4, 8)
  b51 <- bipartite(3, 7, 9)
  b52 <- bipartite(2, 4, 10)
  b61 <- bipartite(3, 7, 11)
  b62 <- bipartite(2, 4, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art14")
  writeFinal(frame, "art14")
  return(frame)
}
art15 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(1, 8, 1)
  b12 <- bipartite(4, 2, 2)
  b21 <- bipartite(1, 8, 3)
  b22 <- bipartite(4, 2, 4)
  b31 <- bipartite(1, 8, 5)
  b32 <- bipartite(4, 2, 6)
  b41 <- bipartite(1, 8, 7)
  b42 <- bipartite(4, 2, 8)
  b51 <- bipartite(1, 8, 9)
  b52 <- bipartite(4, 2, 10)
  b61 <- bipartite(1, 8, 11)
  b62 <- bipartite(4, 2, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art15")
  writeFinal(frame, "art15")
  return(frame)
}
art16 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(2, 2, 1)
  b12 <- bipartite(2, 2, 2)
  b21 <- bipartite(2, 2, 3)
  b22 <- bipartite(2, 2, 4)
  b31 <- bipartite(2, 2, 5)
  b32 <- bipartite(2, 2, 6)
  b41 <- bipartite(2, 2, 7)
  b42 <- bipartite(2, 2, 8)
  b51 <- bipartite(2, 2, 9)
  b52 <- bipartite(2, 2, 10)
  b61 <- bipartite(2, 2, 11)
  b62 <- bipartite(2, 2, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art16")
  writeFinal(frame, "art16")
  return(frame)
}
art17 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(1, 4, 1)
  b12 <- bipartite(1, 4, 2)
  b21 <- bipartite(1, 4, 3)
  b22 <- bipartite(1, 4, 4)
  b31 <- bipartite(1, 4, 5)
  b32 <- bipartite(1, 4, 6)
  b41 <- bipartite(1, 4, 7)
  b42 <- bipartite(1, 4, 8)
  b51 <- bipartite(1, 4, 9)
  b52 <- bipartite(1, 4, 10)
  b61 <- bipartite(1, 4, 11)
  b62 <- bipartite(1, 4, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art17")
  writeFinal(frame, "art17")
  return(frame)
}
art18 <- function(void) {
  star <- starList(6)
  b11 <- bipartite(3, 3, 1)
  b12 <- bipartite(4, 4, 2)
  b21 <- bipartite(3, 3, 3)
  b22 <- bipartite(4, 4, 4)
  b31 <- bipartite(3, 3, 5)
  b32 <- bipartite(4, 4, 6)
  b41 <- bipartite(3, 3, 7)
  b42 <- bipartite(4, 4, 8)
  b51 <- bipartite(3, 3, 9)
  b52 <- bipartite(4, 4, 10)
  b61 <- bipartite(3, 3, 11)
  b62 <- bipartite(4, 4, 12)
  frame <-
    bind_rows(star, b11, b12, b21, b22, b31, b32, b41, b42, b51, b52, b61, b62)
  frame <- frame %>% mutate(graphName = "art18")
  writeFinal(frame, "art18")
  return(frame)
}

art1()
art2()
art3()
art4()
art5()
art6()
art7()
art8()
art9()
art10()
art11()
art12()
art13()
art14()
art15()
art16()
art17()
art18()
art19()


source('2021-06-02-jsa-type-v2-china/init.r')

# Create map dataset

df_all <- get_df()

df_all <- df_all[duplicated == FALSE]

df_all$lat_old <- df_all$lat
df$lon_old <- df_all$lon

df_all$lat <- as.numeric(df_all$lat)
df_all$lon <- as.numeric(df_all$lon)

df <- df_all[
    status %in% c("Valid species", "Synonym"),
    c("idx", "genus", "species", "status", "date", "lat", "lon",
        "global.mapper_n", "global.mapper", "merged.global.mapper", "type.country_n", "type.state")
]
# note: "type.state" field was not cleaned!

# Checks
df_all[type.country_n == "CH", .N, by=status]
df_all[type.country_n == "CH" & (is.na(lat) | is.na(lon)), .N, by=status]
df_all[type.country_n == "CH" & !(is.na(lat) | is.na(lon)), .N, by=status]

# Note: mapped/ plotted in species description curves for China, using lat/lon
# which means 160 valid species (of 665 species; 24.1%) were omitted from the map and curves
# (these with country China, but no lat/lon)
# but were included in 04-flow and 05-type-repo (also including synonyms)
round((160/665*100), 1)

dir_geo_chn <- "data/geo_processed/gadm/china/gadm36_CHN_shp/"
list.files(dir_geo_chn)
v_chn <- st_read(paste0(dir_geo_chn, "gadm36_CHN_0.shp"))
v_chn_pri <- st_read(paste0(dir_geo_chn, "gadm36_CHN_1.shp"))

v_df <- st_as_sf(df[!(is.na(lat) | is.na(lon))], coords = c("lon", "lat"), crs = wgs84)
v_df <- st_transform(v_df, st_crs(v_chn_pri))
v_df <- st_join(v_df, v_chn_pri, join = st_intersects)

df_merged <- data.table(v_df)[, c("idx", "GID_0", "NAME_1")]
names(df_merged) <- c("idx", "china", "pri")

df <- merge(df, df_merged, by="idx", all.x=T, all.y=F)
dim(df)

v_chn_pri <- st_read(paste0(v2_dir_china, "01-map/Prov_ann/Prov_ann.shp"))

v_df <- st_as_sf(df[!(is.na(lat) | is.na(lon))], coords = c("lon", "lat"), crs = wgs84)
v_df <- st_transform(v_df, st_crs(v_chn_pri))
v_df <- st_join(v_df, v_chn_pri, join = st_intersects)

df_merged <- data.table(v_df)[, c("idx", "Eng_NAME")]
names(df_merged) <- c("idx", "pri")

df <- merge(df, df_merged, by="idx", all.x=T, all.y=F, suffixes=c("", "_max"))
dim(df)

wfile <- paste0(v2_dir_china, "01-map/lat-lon.csv")
fwrite(df, wfile, na="")

# Mismatches
# fortunately these are few can be trivialised (/ignored)

df[type.country_n=="CH" & is.na(china)]
# due to boundary issues of GADM shp or plotting in the sea
# (should be rectified on the GADM shp, or lat/lon should be modified)

df[type.country_n!="CH" & china=="CHN"]
# erroneous georeferencing (should be excluded)

df[type.country_n == "CH", .N, by=status]
# tally with values above


# (8) #########

print("Same as above but explicitly 'return' a value as columns")

##
ct <- makeCluster(cores)
registerDoParallel(ct)
##

nt<-10
mymat<-matrix(nrow=nt,ncol=nt)
mymat[1:nt,]<-0
bsum=0
bsum<-foreach(ijk = 1:nt, .combine=cbind ) %dopar% {
	set.seed(ijk)
	mymat[,ijk]<-rnorm(mymat[,ijk])
	junk<-sum(mymat[,ijk])
}
print(bsum)
print(mymat)

stopCluster(ct)
#readline(prompt = "NEXT>")


require(matrixStats) #install.packages('matrixStats')
setwd("~/Dokumenty/studijni_materialy/Edu-hoc/src")

dat1 = read.delim("RssiApp/values4.txt", header = FALSE, sep = ";", comment.char = "&")
dat2 = read.delim("RssiApp2/values4.txt", header = FALSE, sep = ";", comment.char = "&")
dat3 = read.delim("RssiAppSniffer/values4.txt", header = FALSE, sep = ";", comment.char = "&")

basicStats <- function(x){
  m = mean(x)
  sd = sd(x)

  qp = m + alpha * sd
  qm = m - alpha * sd

  result <- list("mean"=m, "sd"=sd, "qp"=qp, "qm"=qm)
  return(result)
}

quantization <- function(stats, values){
  y = c(NA)
  x = c(NA)
  for(i in  1:length(values)){
    if(values[i] > stats$qp){
      y <- c(y,1)
      x <- c(x,i)
    } else if (values[i] < stats$qm){
      y <- c(y,0)
      x <- c(x,i)
    }
  }
  return(list("x"=na.omit(x),"y"=na.omit(y)))
}

mapLocations <- function(locations, bits){
  result = c(NA)

  for(i in locations){
    result = c(result, bits$y[which(bits$x == i)])
  }
  return(na.omit(result))
}

inc <- function(x){
  eval.parent(substitute(x <- x + 1))
}

distance <- function( a, b){
  d <- 0;
  if(length(a) == 0 || length(b) == 0){
    return(max(length(a), length(b)))
  }
  a <- na.omit(a)
  b <- na.omit(b)
  if(length(a) <= length(b)){
    for(i in 1:length(a)){
      if(a[i] != b[i]){
        inc(d)
      }
    }
  } else {
    for(i in 1:length(b)){
      if(a[i] != b[i]){
        inc(d)
      }
    }
  }
  return(d)
}

lengths <- c(NA)
h  <- c(NA)
hS <- c(NA)

alpha <- 0.5
for (i in 1:140){
#i<-1
  values1 <- as.numeric(dat1[i,1:1000]) -256
  values2 <- as.numeric(dat2[i,1:1000]) -256
  values3 <- as.numeric(dat3[i,1:1000]) -256

  s1 <- basicStats(values1)
  r1 <- quantization(s1, values1)

  s2 <- basicStats(values2)
  r2 <- quantization(s2, values2)

  s3 <- basicStats(values3)
  r3 <- quantization(s3, values3)

  #plot(r1$x, r1$y, col = "red", pch=0,  ylim=c(-0.1,1.1))
  #points(r2$x, r2$y+0.02, col = "blue", pch=1)
  #points(r3$x, r3$y+0.04, col = "green", pch=2)

  x_locations = intersect(r1$x,r2$x)
  s_locations = intersect(x_locations,r1$x)

  bits1 <- mapLocations(x_locations, r1)
  bits2 <- mapLocations(x_locations, r2)
  bits3 <- mapLocations(s_locations, r3)

  lengths <- c(lengths, length(bits1))
  if(length(bits1) != 0){
    h <- c(h, distance(bits1, bits2))
    hS <- c(hS, distance(bits1, bits3))
  }

  if(length(bits1) > 5){
    sink("outfile.txt", append=TRUE)
    for(i in 1:length(bits1)){
      cat(bits1[i])
    }
    cat("\n")
    sink()
  }

  #points(x_locations, bits1 -0.02, col = "red", pch=15)
  #points(x_locations, bits2 -0.04, col = "blue", pch=16)
  #points(s_locations, bits3 -0.06, col = "green", pch=17)

}
hist(h, breaks = 50, main = "histogram of distances for non zero vectors between A and B", col = "grey")
hist(hS, breaks = 50, main = "histogram of distances for non zero vectors between AB and sniffer", col = "grey")
hist(lengths, breaks = 50, main = "histogram of lenghts of final vectors", col = "grey")

boxplot(h, hS, names=c("distances between A and B","distances between AB and Sniffer"))

print(table(lengths))


setwd('/home/pc-752828/Dev/results-search-master/outputs-normal')

data_norm <- read.csv(file = 'output-n-price.csv', sep = ',', header = T)

get_df <- function(seed, data) {
  my_ite <- 10
  bo1 <- list()
  bo2 <- list()
  bo3 <- list()
  bo4 <- list()
  rs <- list()
  app <- list()
  seed_l <- list()

  for(i in levels(factor(data$name))) {
    r_bo1 <- data[data['name'] == i & data['bo'] == 'bo1' & data['ite'] == my_ite,][seed,]
    r_bo4 <- data[data['name'] == i & data['bo'] == 'bo4' & data['ite'] == my_ite,][seed,]
    r_bo3 <- data[data['name'] == i & data['bo'] == 'bo3' & data['ite'] == my_ite,][seed,]
    r_bo2 <- data[data['name'] == i & data['bo'] == 'bo5' & data['ite'] == my_ite,][seed,]
    r_rs <- data[data['name'] == i & data['bo'] == 'rs' & data['ite'] == my_ite,][seed,]
    bo1 <- append(bo1, levels(factor(r_bo1$best)))
    bo2 <- append(bo2, levels(factor(r_bo2$best)))
    bo3 <- append(bo3, levels(factor(r_bo3$best)))
    bo4 <- append(bo4, levels(factor(r_bo4$best)))
    rs <- append(rs, levels(factor(r_rs$best)))
    app <- append(app, i)
    seed_l <- append(seed_l, seed)
  }

  df <- cbind(bo1, bo2, bo3, bo4, rs, app)
  df <- data.frame(df)
  df$bo1 = as.numeric(as.character(df$bo1))
  df$bo2 = as.numeric(as.character(df$bo2))
  df$bo3 = as.numeric(as.character(df$bo3))
  df$bo4 = as.numeric(as.character(df$bo4))
  df$rs = as.numeric(as.character(df$rs))

  return(df)
}

df_1 <- get_df(1, data_norm)
df_2 <- get_df(2, data_norm)
df_3 <- get_df(3, data_norm)
df_4 <- get_df(4, data_norm)
df_5 <- get_df(5, data_norm)

summary(df_norm$bo4)
summary(df_norm$rs)

df_norm <- rbind(df_1, df_2, df_3, df_4, df_5)
df <- df_norm
df <- df_5

cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
colnames(df) <- cols
df$ID = as.character(df$ID)
df$ID <- factor(df$ID)
cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search")
new_df <- melt(df, id = c("ID"), measured = cols)
friedman.test(value ~ variable | ID, data = new_df)

new_df %>% friedman_effsize(value ~ variable | ID)

colnames(new_df) <- c("ID", "Abordagem", "Best")

new_df %>% group_by(Abordagem) %>%
  get_summary_stats(Best, type = "median_iqr")


# Rscript gobench.r gobench.out output.png

# Parse the command line args.
args = commandArgs(trailingOnly=TRUE) # this line only works when you run this script from the command line.

library(tidyverse)
library(drlib)

plot = readr::read_delim(args[1], "\t", skip = 3, col_names = FALSE) %>%
  set_names("Name", "Ops", "NsPerOp", "MBPerS", "AllocatedBytesPerOp", "AllocationsPerOp") %>%

  # Clean up the text so we get numbers
  mutate(NsPerOp = as.numeric(str_replace(NsPerOp, " ns/op", "")),
         MBPerS = as.numeric(str_replace(MBPerS, " MB/s", "")),
         AllocatedBytesPerOp = as.numeric(str_replace(AllocatedBytesPerOp, " B/op", "")),
         AllocationsPerOp = as.numeric(str_replace(AllocationsPerOp, " allocs/op", "")),
         Ops = as.numeric(Ops)) %>%
  filter(!is.na(NsPerOp)) %>%

  # Strip out the "Benchmark" prefix from the benchmark name.
  mutate (Name = str_replace(Name, "Benchmark", "")) %>%

  # Split out the cores.
  separate(Name, c("Name", "Cores"), "-") %>%
  mutate(Cores = as.numeric(Cores)) %>%

  # Split out the bytes.
  separate(Name, c("Name", "Bytes"), "/") %>%
  mutate(Bytes = as.numeric(Bytes)) %>%

  # Generate the plots.
  ggplot(aes(Name, NsPerOp)) +
  geom_col() +
  rotate_x_labels(vjust = .5) +
  # labs(title="Title", subtitle="Sub title") +
  xlab("name") +
  ylab("nanoseconds per operation") +
  facet_wrap(~ Bytes, scales="free_y")

ggsave(args[2], plot, width = 16, height = 9)


#' @title make.list
#' @description Make a simple expanded list of parameter values with which parallel runs can be made.
#' @family abysmally documented
#' @author  Jae Choi, \email{jae.choi@dfo-mpo.gc.ca}
#' @export
# define compact list of variable (e.g.,  year, var, etc)  combinations for parallel processing
# which can be accessed within a parallel run to recover variable comnbinations using a single index
#    outside of parallel run
#    p = make.list( list(p$vars.to.model, p$years.to.model, p$regions.to.model), Y=list() )
#    ...
#    inside of a parallel run
#    i = 1 ... parallel nids or "nruns"
#     v = p$runs[i,1]
#     y = p$runs[i,2]
#     r = p$runs[i,3]

  make.list = function( Z, Y=list(), delimit="~" ) {

    nvars = length(Z)  # Z must be a list
    sm = NULL
    for (i in 1:nvars) {
      sm = c( sm, mode( Z[[i]] ) )
    }

    Q = expand.grid(Z)
    X = Q[,1]
    if ( nvars > 1 ) {
      for (i in 2:nvars) {  X = paste( X, Q[,i], sep=delimit )   }
    }

    Y$process.list = list( data=X, sm=sm, delimit=delimit, nvars=nvars, varnames=names(Q), Z=Z )
    Y$runs = break.list( Y$process.list )
    Y$nruns = nrow( Y$runs )

    return( Y)

  }


mcmcMH <- function(target, init.theta, proposal.sd = NULL,
                   n.iterations, covmat = NULL,
                   limits=list(lower = NULL, upper = NULL),
                   adapt.size.start = NULL, adapt.size.cooling = 0.99,
                   adapt.shape.start = NULL, adapt.shape.stop = NULL,
                   print.info.every = n.iterations/100,
                   verbose = FALSE, max.scaling.sd = 50) {

  # initialise theta
  theta.current <- init.theta
  theta.propose <- init.theta

  # extract theta of gaussian proposal
  covmat.proposal <- covmat
  lower.proposal <- limits$lower
  upper.proposal <- limits$upper

  # reorder vector and matrix by names, set to default if necessary
  theta.names <- names(init.theta)
  if (!is.null(proposal.sd) && is.null(names(proposal.sd))) {
    names(proposal.sd) <- theta.names
  }

  if (is.null(covmat.proposal)) {
    if (is.null(proposal.sd)) {
      proposal.sd <- init.theta/10
    }
    covmat.proposal <-
      matrix(diag(proposal.sd[theta.names]^2, nrow = length(theta.names)),
             nrow = length(theta.names),
             dimnames = list(theta.names, theta.names))
  } else {
    covmat.proposal <- covmat.proposal[theta.names,theta.names]
  }

  if (is.null(lower.proposal)) {
    lower.proposal <- init.theta
    lower.proposal[] <- -Inf
  } else {
    lower.proposal <- lower.proposal[theta.names]
  }

  if (is.null(upper.proposal)) {
    upper.proposal <- init.theta
    upper.proposal[] <- Inf
  } else {
    upper.proposal <- upper.proposal[theta.names]
  }

  # covmat init
  covmat.proposal.init <- covmat.proposal

  adapting.size <- FALSE # will be set to TRUE once we start
  # adapting the size

  adapting.shape <- 0  # will be set to the iteration at which
  # adaptation starts

  # find estimated theta
  theta.estimated.names <- names(which(diag(covmat.proposal) > 0))

  # evaluate target at theta init
  target.theta.current <- target(theta.current)

  if (!is.null(print.info.every)) {
    message(Sys.time(), ", Init: ", printNamedVector(theta.current[theta.estimated.names]),
            ", target: ", target.theta.current)
  }

  # trace
  trace <- matrix(ncol=length(theta.current)+1, nrow=n.iterations, 0)
  colnames(trace) <- c(theta.estimated.names, "log.density")

  # acceptance rate
  acceptance.rate <- 0

  # scaling factor for covmat size
  scaling.sd  <- 1

  # scaling multiplier
  scaling.multiplier <- 1

  # empirical covariance matrix (0 everywhere initially)
  covmat.empirical <- covmat.proposal
  covmat.empirical[,] <- 0

  # empirical mean vector
  theta.mean <- theta.current

  # if print.info.every is null never print info
  if (is.null(print.info.every)) {
    print.info.every <- n.iterations + 1
  }

  start_iteration_time <- Sys.time()

  for (i.iteration in seq_len(n.iterations)) {

    # adaptive step
    if (!is.null(adapt.size.start) && i.iteration >= adapt.size.start &&
        (is.null(adapt.shape.start) || acceptance.rate*i.iteration < adapt.shape.start)) {
      if (!adapting.size) {
        message("\n---> Start adapting size of covariance matrix")
        adapting.size <- TRUE
      }
      # adapt size of covmat until we get enough accepted jumps
      scaling.multiplier <- exp(adapt.size.cooling^(i.iteration-adapt.size.start) * (acceptance.rate - 0.234))
      scaling.sd <- scaling.sd * scaling.multiplier
      scaling.sd <- min(c(scaling.sd,max.scaling.sd))
      # only scale if it doesn't reduce the covariance matrix to 0
      covmat.proposal.new <- scaling.sd^2*covmat.proposal.init
      if (!(any(diag(covmat.proposal.new)[theta.estimated.names] <
                .Machine$double.eps))) {
        covmat.proposal <- covmat.proposal.new
      }

    } else if (!is.null(adapt.shape.start) &&
               acceptance.rate*i.iteration >= adapt.shape.start &&
               (adapting.shape == 0 || is.null(adapt.shape.stop) ||
                i.iteration < adapting.shape + adapt.shape.stop)) {
      if (!adapting.shape) {
        message("\n---> Start adapting shape of covariance matrix")
        # flush.console()
        adapting.shape <- i.iteration
      }

      ## adapt shape of covmat using optimal scaling factor for multivariate target distributions
      scaling.sd <- 2.38/sqrt(length(theta.estimated.names))

      covmat.proposal <- scaling.sd^2 * covmat.empirical
    } else if (adapting.shape > 0) {
      message("\n---> Stop adapting shape of covariance matrix")
      adapting.shape <- -1
    }

    # print info
    if (i.iteration %% ceiling(print.info.every) == 0) {
      message(Sys.time(), ", Iteration: ",i.iteration,"/", n.iterations,
              ", acceptance rate: ",
              sprintf("%.3f",acceptance.rate), appendLF=FALSE)
      if (!is.null(adapt.size.start) || !is.null(adapt.shape.start)) {
        message(", scaling.sd: ", sprintf("%.3f", scaling.sd),
                ", scaling.multiplier: ", sprintf("%.3f", scaling.multiplier),
                appendLF=FALSE)
      }
      message(", state: ",(printNamedVector(theta.current)))
      message(", logdensity: ", target.theta.current)
    }

    # propose another parameter set
    if (any(diag(covmat.proposal)[theta.estimated.names] <
            .Machine$double.eps)) {
      print(covmat.proposal[theta.estimated.names,theta.estimated.names])
      stop("non-positive definite covmat",call.=FALSE)
    }
    if (length(theta.estimated.names) > 0) {
      theta.propose[theta.estimated.names] <-
        as.vector(rtmvnorm(1,
                           mean =
                             theta.current[theta.estimated.names],
                           sigma =
                             covmat.proposal[theta.estimated.names,theta.estimated.names],
                           lower =
                             lower.proposal[theta.estimated.names],
                           upper = upper.proposal[theta.estimated.names]))
    }

    # evaluate posterior of proposed parameter
    target.theta.propose <- target(theta.propose)
    # if return value is a vector, set log.density and trace

    if (!any(is.finite(target.theta.propose))) { # GK: changed to include "any" as getting error with list
      # if posterior is 0 then do not compute anything else and don't accept
      log.acceptance <- -Inf

    }else{

      # compute Metropolis-Hastings ratio (acceptance probability)
      log.acceptance <- target.theta.propose - target.theta.current
      log.acceptance <- log.acceptance +
        dtmvnorm(x = theta.current[theta.estimated.names],
                 mean =
                   theta.propose[theta.estimated.names],
                 sigma =
                   covmat.proposal[theta.estimated.names,
                                   theta.estimated.names],
                 lower =
                   lower.proposal[theta.estimated.names],
                 upper =
                   upper.proposal[theta.estimated.names],
                 log = TRUE)
      log.acceptance <- log.acceptance -
        dtmvnorm(x = theta.propose[theta.estimated.names],
                 mean = theta.current[theta.estimated.names],
                 sigma =
                   covmat.proposal[theta.estimated.names,
                                   theta.estimated.names],
                 lower =
                   lower.proposal[theta.estimated.names],
                 upper =
                   upper.proposal[theta.estimated.names],
                 log = TRUE)

    }

    if (verbose) {
      message("Propose: ", theta.propose[theta.estimated.names],
              ", target: ", target.theta.propose,
              ", acc prob: ", exp(log.acceptance), ", ",
              appendLF = FALSE)
    }

    if (is.accepted <- (log(runif (1)) < log.acceptance)) {
      # accept proposed parameter set
      theta.current <- theta.propose
      target.theta.current <- target.theta.propose
      if (verbose) {
        message("accepted")
      }
    } else if (verbose) {
      message("rejected")
    }
    trace[i.iteration, ] <- c(theta.current, target.theta.current)

    # update acceptance rate
    if (i.iteration == 1) {
      acceptance.rate <- is.accepted
    } else {
      acceptance.rate <- acceptance.rate +
        (is.accepted - acceptance.rate) / i.iteration
    }

    # update empirical covariance matrix
    if (adapting.shape >= 0) {
      tmp <- updateCovmat(covmat.empirical, theta.mean,
                          theta.current, i.iteration)
      covmat.empirical <- tmp$covmat
      theta.mean <- tmp$theta.mean
    }

  }

  return(list(trace = trace,
              acceptance.rate = acceptance.rate,
              covmat.empirical = covmat.empirical))
}

#'Print named vector
#'
#'Print named vector with format specified by \code{fmt} (2 decimal places by default).
#' @param x named vector
#' @inheritParams base::sprintf
#' @inheritParams base::paste
#' @export
#' @seealso \code{\link[base]{sprintf}}
#' @keywords internal
printNamedVector <- function(x, fmt="%.2f", sep=" | ") {

  paste(paste(names(x),sprintf(fmt,x),sep=" = "),collapse=sep)

}

#' Simulate forward a stochastic model
#'
#' This function uses the function \code{\link[adaptivetau]{ssa.adaptivetau}} to simulate the model and returns the trajectories in a valid format for the class \code{\link{fitmodel}}.
#' @param theta named vector of model parameters.
#' @param init.state named vector of initial state of the model.
#' @param times time sequence for which state of the model is wanted; the first value of times must be the initial time.
#' @inheritParams adaptivetau::ssa.adaptivetau
#' @export
#' @import adaptivetau
#' @return a data.frame of dimension \code{length(times)x(length(init.state)+1)} with column names equal to \code{c("time",names(init.state))}.
simulateModelStochastic <- function(theta,init.state,times,transitions,rateFunc) {

  stoch <- as.data.frame(ssa.adaptivetau(init.state,transitions,rateFunc,theta,tf=diff(range(times))))

  # rescale time as absolute value
  stoch$time <- stoch$time + min(times)

  # interpolate
  traj <- cbind(time=times,apply(stoch[,-1],2,function(col){approx(x=stoch[,1],y=col,xout=times,method="constant")$y}))

  return(as.data.frame(traj))

}

#'Simulate several replicate of the model
#'
#'Simulate several replicate of a fitmodel using its function simulate
#' @param times vector of times at which you want to observe the states of the model.
#' @param n number of replicated simulations.
#' @param observation logical, if \code{TRUE} simulated observation are generated by \code{rTrajObs}.
#' @inheritParams testFitmodel
#' @export
#' @import plyr
#' @return a data.frame of dimension \code{[nxlength(times)]x[length(init.state)+2]} with column names equal to \code{c("replicate","time",names(init.state))}.
simulateModelReplicates <- function(fitmodel,theta, init.state, times, n, observation=FALSE) {

  stopifnot(inherits(fitmodel,"fitmodel"),n>0)

  if(observation && is.null(fitmodel$dPointObs)){
    stop("Can't generate observation as ",sQuote("fitmodel")," doesn't have a ",sQuote("dPointObs")," function.")
  }

  rep <- as.list(1:n)
  names(rep) <- rep

  if (n > 1) {
    progress = "text"
  } else {
    progress = "none"
  }

  traj.rep <- ldply(rep,function(x) {

    if(observation){
      traj <- rTrajObs(fitmodel, theta, init.state, times)
    } else {
      traj <- fitmodel$simulate(theta,init.state,times)
    }

    return(traj)

  },.progress=progress,.id="replicate")

  return(traj.rep)
}

#'Simulate model until extinction
#'
#'Return final state at extinction
#' @param extinct character vetor. Simulations stop when all these state are extinct.
#' @param time.init numeric. Start time of simulation.
#' @param time.step numeric. Time step at which extinction is checked
#' @inheritParams testFitmodel
#' @inheritParams simulateModelReplicates
#' @inheritParams particleFilter
#' @export
#' @import plyr parallel doParallel
simulateFinalStateAtExtinction <- function(fitmodel, theta, init.state, extinct=NULL ,time.init=0, time.step=100, n=100, observation=FALSE, n.cores = 1) {

  stopifnot(inherits(fitmodel,"fitmodel"),n>0)

  if(observation && is.null(fitmodel$dPointObs)){
    stop("Can't generate observation as ",sQuote("fitmodel")," doesn't have a ",sQuote("dPointObs")," function.")
  }

  if(is.null(n.cores)){
    n.cores <- detectCores()
  }

  if(n.cores > 1){
    registerDoParallel(cores=n.cores)
  }

  rep <- as.list(1:n)
  names(rep) <- rep

  if (n > 1 && n.cores==1) {
    progress = "text"
  } else {
    progress = "none"
  }

  times <- c(time.init, time.step)

  final.state.rep <- ldply(rep,function(x) {

    if(observation){
      traj <- rTrajObs(fitmodel, theta, init.state, times)
    } else {
      traj <- fitmodel$simulate(theta,init.state,times)
    }

    current.state <- unlist(traj[nrow(traj),fitmodel$state.names])
    current.time <- last(traj$time)

    while(any(current.state[extinct]>=0.5)){

      times <- times + current.time

      if(observation){
        traj <- rTrajObs(fitmodel, theta, current.state, times)
      } else {
        traj <- fitmodel$simulate(theta, current.state,times)
      }

      current.state <- unlist(traj[nrow(traj),fitmodel$state.names])
      current.time <- last(traj$time)
    }

    return(data.frame(t(c(time=current.time,current.state))))

  },.progress=progress,.id="replicate",.parallel=(n.cores > 1),.paropts=list(.inorder=FALSE))

  return(final.state.rep)
}

#'Update covariance matrix
#'
#'Update covariance matrix using a stable one-pass algorithm. This is much more efficient than using \code{\link{cov}} on the full data.
#' @param covmat covariance matrix at iteration \code{i-1}. Must be numeric, symmetrical and named.
#' @param theta.mean mean vector at iteration \code{i-1}. Must be numeric and named.
#' @param theta vector of new value at iteration \code{i}. Must be numeric and named.
#' @param i current iteration.
#' @references \url{http://en.wikipedia.org/wiki/Algorithms\%5Ffor\%5Fcalculating\%5Fvariance#Covariance}
#' @export
#' @keywords internal
#' @return A list of two elements
#' \itemize{
#' \item \code{covmat} update covariance matrix
#' \item \code{theta.mean} updated mean vector
#' }
updateCovmat <- function(covmat,theta.mean,theta,i) {

  if(is.null(names(theta))){
    stop("Argument ",sQuote("theta")," must be named.",.call=FALSE)
  }
  if(is.null(names(theta.mean))){
    stop("Argument ",sQuote("theta.mean")," must be named.",.call=FALSE)
  }
  if(is.null(rownames(covmat))){
    stop("Argument ",sQuote("covmat")," must have named rows.",.call=FALSE)
  }
  if(is.null(colnames(covmat))){
    stop("Argument ",sQuote("covmat")," must have named columns.",.call=FALSE)
  }

  covmat <- covmat[names(theta),names(theta)]
  theta.mean <- theta.mean[names(theta)]

  residual <- as.vector(theta-theta.mean)
  covmat <- (covmat*(i-1)+(i-1)/i*residual%*%t(residual))/i
  theta.mean <- theta.mean + residual/i

  return(list(covmat=covmat,theta.mean=theta.mean))
}

#'Burn and thin MCMC chain
#'
#'Return a burned and thined trace of the chain.
#' @param trace either a \code{data.frame} or a \code{list} of \code{data.frame} with all variables in column, as outputed by \code{\link{mcmcMH}}. Accept also an \code{mcmc} or \code{mcmc.list} object.
#' @param burn proportion of the chain to burn.
#' @param thin number of samples to discard per sample that is being kept
#' @export
#' @import coda
#' @return an object with the same format as \code{trace} (\code{data.frame} or \code{list} of \code{data.frame} or \code{mcmc} object or \code{mcmc.list} object)
burnAndThin <- function(trace, burn = 0, thin = 0) {

  convert_to_mcmc <- FALSE

  if(class(trace)=="mcmc"){
    convert_to_mcmc <- TRUE
    trace <- as.data.frame(trace)
  } else if(class(trace)=="mcmc.list"){
    convert_to_mcmc <- TRUE
    trace <- as.list(trace)
  }

  if(is.data.frame(trace) || is.matrix(trace)){

    # remove burn
    if (burn > 0) {
      trace <- trace[-(1:burn), ]
    }
    # thin
    trace <- trace[seq(1, nrow(trace), thin + 1), ]

    if(convert_to_mcmc){
      trace <- mcmc(trace)
    }

  } else {

    trace <- lapply(trace, function(x) {

      # remove burn
      if (burn > 0) {
        x <- x[-(1:burn), ]
      }
      # thin
      x <- x[seq(1, nrow(x), thin + 1), ]

      if(convert_to_mcmc){
        x <- mcmc(x)
      }

      return(x)
    })

    if(convert_to_mcmc){
      trace <- mcmc.list(trace)
    }
  }

  return(trace)
}

#'Distance weighted by number of oscillations
#'
#'This positive distance is the mean squared differences between \code{x} and the \code{y}, divided by the square of the number of times the \code{x} oscillates around the \code{y} (see note below for illustration).
#' @param x,y numeric vectors of the same length.
#' @note To illustrate this distance, suppose we observed a time series \code{y = c(1,3,5,7,5,3,1)} and we have two simulated time series \code{x1 = (3,5,7,9,7,5,3)} and \code{x2 = (3,5,3,5,7,5,3)}; \code{x1} is consistently above \code{y} and \code{x2} oscillates around \code{y}. While the squared differences are the same, we obtain \eqn{d(y, x1) = 4} and \eqn{d(y, x2) = 1.3}.
#' @export
distanceOscillation <- function(x, y) {

  # check x and y have same length
  if(length(x)!=length(y)){
    stop(sQuote("x")," and ",sQuote("y")," must be vector of the same length")
  }

  # 1 + number of times x oscillates around y
  n.oscillations <- 1+length(which(diff((x-y)>0)!=0))

  dist <- sum((x-y)^2)/(length(x)*n.oscillations)

  return(dist)
}

#'Export trace in Tracer format
#'
#'Print \code{trace} in a \code{file} that can be read by the software Tracer.
#' @param trace a \code{data.frame} with one column per estimated parameter, as returned by \code{\link{burnAndThin}}
#' @inheritParams utils::write.table
#' @note Tracer is a program for analysing the trace files generated by Bayesian MCMC runs. It can be dowloaded at \url{http://tree.bio.ed.ac.uk/software/tracer}.
#' @export
#' @seealso burnAndThin
#' @keywords internal
export2Tracer <- function(trace, file) {

  if(is.mcmc(trace)){
    trace <- as.data.frame(trace)
  }

  if(!"iteration"%in%names(trace)){
    trace$iteration <- (1:nrow(trace) - 1)
  }

  trace <- trace[c("iteration",setdiff(names(trace),c("iteration","weight")))]
  write.table(trace,file=file,quote=FALSE,row.names=FALSE,sep="\t")

}


#' @title
#'  Prepare for plotting the bootstrapped metrics at the species level of one or
#'  multiple networks.
#'
#' @description
#'  Takes a list of network interactions (each interaction being repeated as
#'  many times as it was observed), and bootstraps the given species level
#'  metric (`index`) for each network. Runs `boot_specieslevel_n()` for a list
#'  of network interactions and prepares the data for plotting with `ggplot`.
#'  The output list can be passed to
#'  \code{\link[bootstrapnet]{gg_specieslevel_compare_webs}} or to
#'  \code{\link[bootstrapnet]{get_stats_multi}} and then its output to
#'  \code{\link[bootstrapnet]{gg_specieslevel_web_by_web}}. See examples below.
#'
#' @param lst
#'  A list of one or multiple data frames of interactions from which to build
#'  and sample web matrices. Each interaction (row in the data frame) must be
#'  repeated as many times as it was observed. E.g. if the interaction species_1
#'  x species_2 was observed 5 times, then repeat that row 5 times within the
#'  data frame.
#'
#' @param col_lower
#'  Quoted column name in `data` for lower trophic level species (plants).
#'
#' @param col_higher
#'  Quoted column name in `data` for higher trophic level species (insects).
#'
#' @param index
#'  Passed to \code{\link[bipartite]{networklevel}}. See
#'  `?bipartite::networklevel` for details.
#'
#' @param level
#'  Passed to \code{\link[bipartite]{networklevel}}. See
#'  `?bipartite::networklevel` for details. For which level should the
#'  level-specific indices be computed: 'both' (default), 'lower' or 'higher'?
#'
#' @param start
#'  Integer. The sample size (number of interactions) to start the bootstrap
#'  with. If the start sample size is small (e.g. 5 or 10), then first
#'  iterations might results in NaN-s and warning messages are displayed.
#'  Consider to set `start` to maybe 10\\% of your total unique interactions.
#'
#' @param step
#'  Integer. Sample size (number of interactions) used to increase gradually the
#'  sampled network until all interactions are sampled. If `step` is too small
#'  (e.g. 1) then the computation time is very long depending on your total
#'  number of interactions from which samples are taken. Consider to set `step`
#'  to maybe 5-10\\% of your total unique interactions.
#'
#' @param n_boot
#'  Number of desired bootstraps (50 or 100 can be enough).
#'
#' @param n_cpu
#'  Number of CPU-s to use for parallel processing.
#'
#' @param probs
#'  A numeric vector of two probabilities in `[0, 1]`. Passed to
#'  \code{\link[matrixStats]{rowQuantiles}} and used for building the lower and
#'  upper bounds of the confidence intervals. Defaults to `c(0.025, 0.975)`,
#'  which corresponds to a 95\\% confidence interval.
#'
#' @param ...
#'  Other arguments passed to \code{\link[bipartite]{specieslevel}}.
#'
#' @return
#'  A 3 levels list of the same length as `lst`. The list can be passed to
#'  \code{\link[bootstrapnet]{gg_specieslevel_compare_webs}} or to
#'  \code{\link[bootstrapnet]{get_stats_multi}} and then its output to
#'  \code{\link[bootstrapnet]{gg_specieslevel_web_by_web}}. Each element of the
#'  list is a sub-list corresponding to each network. Each sub-list contains
#'  further sub-lists with the bootstrapped metric values at 'lower', 'higher'
#'  or 'both' levels. Each sub-sub-lists contains two data frames: `stats_df`
#'  and `lines_df`, which can be used by the `ggplot2::geom_line()` function.
#'  See the return section of \code{\link[bootstrapnet]{get_stats_single}} for
#'  more details about `stats_df` and `lines_df` data frames.
#'
#' @examples
#'
#' library(bootstrapnet)
#' library(bipartite)
#' library(magrittr)
#' data(Safariland)
#'
#' set.seed(321)
#' Safariland_1 <- Safariland[, sort(sample.int(ncol(Safariland), 20))]
#' set.seed(123)
#' Safariland_2 <- Safariland[, sort(sample.int(ncol(Safariland), 20))]
#'
#' lst <- list(s1 = Safariland_1, s2 = Safariland_2) %>%
#'   lapply(web_matrix_to_df) %>%
#'   boot_specieslevel(col_lower = "lower", # column name for plants
#'                     col_higher = "higher", # column name for insects
#'                     index = "betweenness",
#'                     level = "both",
#'                     start = 50,
#'                     step = 20,
#'                     n_boot = 10,
#'                     n_cpu = 2)
#'
#' lst %>%
#'   get_stats_multi() %>%
#'   gg_specieslevel_compare_webs(sp_lower = "Alstroemeria aurea",
#'                                sp_higher = "Allograpta.Toxomerus")
#'
#' lst %>%
#'   gg_specieslevel_web_by_web(sp_lower = c("Alstroemeria aurea",
#'                                           "Aristotelia chilensis"))
#'
#' @export
#'
#' @md
boot_specieslevel <- function(lst,
                              col_lower,
                              col_higher,
                              index,
                              level,
                              start,
                              step,
                              n_boot,
                              n_cpu,
                              probs = c(0.025, 0.975),
                              ...){

  webs_stats <- vector(mode = "list", length = length(lst))
  names(webs_stats) <- names(lst)

  for (i in 1:length(webs_stats)){
    webs_stats[[i]] <- lst[[i]] %>%
      boot_specieslevel_n(col_lower = col_lower,
                          col_higher = col_higher,
                          index = index,
                          level = level,
                          start = start,
                          step = step,
                          n_boot = n_boot,
                          n_cpu = n_cpu,
                          ...) %>%
      lapply(FUN = get_stats_single, probs = probs)
  }

  return(webs_stats)
}

#' @title
#'  Bootstrap metric at the species level multiple times.
#'
#' @description
#'  Bootstrap a single network of interactions n times in parallel. This
#'  function is used for network metrics at the species level. Starts with a
#'  small sample size of interactions (e.g. `start = 30`), builds the
#'  corresponding web matrix/network, computes its metric (e.g. `index = "d"`)
#'  using \code{\link[bipartite]{specieslevel}}, then adds new interactions
#'  (e.g. `step = 20`) until all interactions are sampled. The last sample is
#'  actually the entire network. Repeats n times (as given in `n_boot`) these
#'  steps in parallel on multiple CPUs.
#'
#' @param data
#'  Data frame of interactions from which to build and sample web matrices. Each
#'  interaction (row in the data frame) must be repeated as many times as it was
#'  observed. E.g. if species_1 x species_2 was observed 5 times, then repeat
#'  that row 5 times within the data frame. See examples below.
#'
#' @param col_lower
#'  Quoted column name in `data` for lower trophic level species (plants).
#'
#' @param col_higher
#'  Quoted column name in `data` for higher trophic level species (insects).
#'
#' @param index
#'  Passed to \code{\link[bipartite]{specieslevel}}. See
#'  `?bipartite::specieslevel` for details.
#'
#' @param level
#'  Passed to \code{\link[bipartite]{specieslevel}}. See
#'  `?bipartite::specieslevel` for details. For which level should the
#'  level-specific indices be computed: 'both' (default), 'lower' or 'higher'?
#'
#' @param start
#'  Integer. The sample size (number of interactions) to start the bootstrap
#'  with. If the start sample size is small (e.g. 5 or 10), then first
#'  iterations might results in NaN-s and warning messages are displayed.
#'  Consider to set `start` to maybe 10\\% of your total unique interactions.
#'
#' @param step
#'  Integer. Sample size (number of interactions) used to increase gradually the
#'  sampled network until all interactions are sampled. If `step` is too small
#'  (e.g. 1) then the computation time is very long depending on your total
#'  number of interactions from which samples are taken. Consider to set `step`
#'  to maybe 5-10\\% of your total unique interactions.
#'
#' @param n_boot
#'  Number of desired bootstraps (50 or 100 can be enough).
#'
#' @param n_cpu
#'  Number of CPU-s to use for parallel processing.
#'
#' @param ...
#'  Other arguments passed to \code{\link[bipartite]{specieslevel}} like
#'  `logbase`, etc.
#'
#' @return
#'  Returns a list of 1, 2 or 4 arrays of matrices. The species names are stored
#'  as the row names of each matrix. The number of columns of a matrix indicates
#'  how many iterations took place. This is decided internally based on the given
#'  values to `start`, `step` and the total number of rows (interactions) in
#'  `data`. The column names give the sample size at each iteration. The last
#'  iteration (last column name) is always the entire network (total number of
#'  interactions in `data`). The 3rd dimension (number of matrices in the array)
#'  corresponds to `n_boot` (number of bootstraps).
#'
#' @examples
#'
#' library(bootstrapnet)
#' library(magrittr)
#' library(bipartite)
#' data(Safariland)
#'
#' Safariland %>%
#'   web_matrix_to_df() %>%
#'   boot_specieslevel_n(col_lower = "lower", # column name for plants
#'                       col_higher = "higher", # column name for insects
#'                       index = "d",
#'                       level = "both",
#'                       start = 100,
#'                       step = 100,
#'                       n_boot = 10,
#'                       n_cpu = 2)
#'
#' @import data.table
#'
#' @importFrom foreach foreach %dopar% registerDoSEQ
#' @importFrom parallel splitIndices makeCluster stopCluster
#' @importFrom doParallel registerDoParallel
#' @importFrom iterators iter
#'
#' @export
#'
#' @md
boot_specieslevel_n <- function(data,
                                col_lower,
                                col_higher,
                                index,
                                level,
                                start,
                                step,
                                n_boot,
                                n_cpu,
                                ...){
  test_data(data, col_lower, col_higher)
  cls_data <- class(data)
  if (! "data.table" %in% class(data)) data.table::setDT(data)

  test_index_specieslevel(index)

  test_level_value(level)

  test_data_species_names(data, col_lower, col_higher)

  # Get sample sizes. Column names of the resulting bootstrap matrices will
  # carry information about the sample size at each iteration/bootstrap step.
  # This is run also before the parallel processing initiation because it can
  # throw error messages if the start and step values are not adequate. No need
  # to initiate parallel processing for something that will fail.
  iter_spl_size <- sample_indices(data = data, start = start, step = step, seed = 42) %>%
    sapply(length)

  { # Start parallel processing
    chunks <- parallel::splitIndices(n_boot, n_cpu)
    cl <- parallel::makeCluster(n_cpu)
    doParallel::registerDoParallel(cl)
    i <- NULL # to avoid 'Undefined global functions or variables: i' in R CMD check

    boot_lst <- foreach::foreach(i = iterators::iter(chunks),
                                 .errorhandling = 'pass',
                                 .packages = c("data.table",
                                               "bipartite",
                                               "magrittr"),
                                 .export = c("boot_specieslevel_once",
                                             "split_in_chunks",
                                             "sample_indices",
                                             "boot_specieslevel_lower_or_higher",
                                             "boot_specieslevel_both_levels")) %dopar%
                                             {
                                               lapply(i, FUN = function(x)
                                                 boot_specieslevel_once(data = data,
                                                                        col_lower = col_lower,
                                                                        col_higher = col_higher,
                                                                        index = index,
                                                                        level = level,
                                                                        start = start,
                                                                        step = step,
                                                                        seed = x,
                                                                        ...) )
                                             }
    parallel::stopCluster(cl)
    remove(cl)
    foreach::registerDoSEQ()
    } # End of parallel processing

  boot_lst <- unlist(boot_lst, recursive = FALSE)

  metric_names <- names(boot_lst[[1]])
  n <- length(metric_names)

  if (n == 1) {
    results <- get_list_of_arrays(boot_lst, metric_names, n, iter_spl_size)
    # Convert data back to data frame if applicable
    if (! "data.table" %in% cls_data) data.table::setDF(data)
    return(results)

  } else if (n == 2) {
    results <- get_list_of_arrays(boot_lst, metric_names, n, iter_spl_size)
    if (! "data.table" %in% cls_data) data.table::setDF(data)
    return(results)

  } else if (n == 4) {
    results <- get_list_of_arrays(boot_lst, metric_names, n, iter_spl_size)
    if (! "data.table" %in% cls_data) data.table::setDF(data)
    return(results)
  }
}

#' @title
#'  Bootstrap metric at the species level once.
#'
#' @description
#'  You will rarely use this function alone. It was designed to be executed in
#'  parallel by \code{\link[bootstrapnet]{boot_specieslevel_n}}. See more
#'  details there.
#'
#' @param data
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param col_lower
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param col_higher
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param index
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param level
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param start
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param step
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @param seed
#'  Set seed to get reproducible random results. Passed to `set.seed()`.
#'
#' @param ...
#'  See \code{\link[bootstrapnet]{boot_specieslevel_n}}.
#'
#' @return
#'  A list of 1, 2 or 4 matrices. This depends on the provided `index` metric
#'  and `level` value.
#'
#' @references
#'  This function is a wrapper of \code{\link[bipartite]{specieslevel}}.
#'
#' @import data.table
#'
#' @importFrom bipartite specieslevel
#'
#' @export
#'
#' @md
boot_specieslevel_once <- function(data,
                                   col_lower,
                                   col_higher,
                                   index,
                                   level,
                                   start,
                                   step,
                                   seed,
                                   ...){

  # List of sampled indices as vectors for bootstrapping. Each vector of indices
  # is used to build a web matrix/network from data.
  ids_lst <- sample_indices(data = data, start = start, step = step, seed = seed)

  # Allocate memory for a list of outputs (data frames) from
  # bipartite::specieslevel()
  metric_lst <- vector(mode = "list", length = length(ids_lst))

  # Sample interactions with the indices build above and compute the species
  # level metric until all interactions are sampled. In case of warnings or
  # errors (most probably related to small sample size of a network at first
  # iterations), then return NA-s for the metric so it doesn't break the
  # simulation.
  for (i in 1:length(ids_lst)){
    metric_lst[[i]] <- try({
      # Some metrics may have random processes in their computation, so set seed
      # here also for reproducibility.
      web <- data[ids_lst[[i]], table(get(col_lower), get(col_higher))]
      set.seed(42)
      bipartite::specieslevel(web = web, index = index, level = level, ...)
    })
  }

  if (level == "lower") {
    boot_results <- boot_specieslevel_lower_or_higher(data = data,
                                                      col = col_lower,
                                                      metric_lst = metric_lst,
                                                      level)
    return(boot_results)

  } else if (level == "higher") {
    boot_results <- boot_specieslevel_lower_or_higher(data = data,
                                                      col = col_higher,
                                                      metric_lst = metric_lst,
                                                      level)
    return(boot_results)

  } else if (level == "both") {
    boot_results <- boot_specieslevel_both_levels(data = data,
                                                  col_lower = col_lower,
                                                  col_higher = col_higher,
                                                  metric_lst = metric_lst)
    return(boot_results)
  }
}