#!/sw/apps/R/x86_64/3.2.3/milou/bin/Rscript
# Description:
# R-script for converting output from AlleleCount to BAF and LogR values.
#
# Input:
# AlleleCounter output file for tumor and normal samples
# The first line should contain a header describing the data
# The following columns and headers should be present:
# CHR    POS     Count_A Count_C Count_G Count_T Good_depth
#
# Output:
# BAF and LogR tables (tab delimited text files)
#######################################################################################################

##First read in the arguments listed at the command line
args = commandArgs(trailingOnly=TRUE)

##args is now a list of character vectors
## First check to see if arguments are passed.
if(length(args)<5){
    stop("No input files supplied\n\nUsage:\nRscript convertAlleleCounts.r tumorid tumorac normalid normalac gender\nWhere:\ntumorid - id of tumor sample\ntumorac - output from AlleleCount for the tumor\nnormalid - id of normal sample\nnormalac - output from AlleleCount for the normal\ngender - XX or XY\n\n")
} else{
    tumorid = args[1]
    tumorac = args[2]
    normalid = args[3]
    normalac = args[4]
    gender = args[5]
}

tumorcounts = read.table(tumorac, header=T, sep="\t")
normalcounts = read.table(normalac, header=T, sep="\t")

SNPpos = matrix(nrow = dim(normalcounts)[1],ncol = 2)

rownames(SNPpos) = paste("snp",1:dim(SNPpos)[1],sep="")

#Change rownames to "chr_pos" instead, such as 1_44552
#This does not exactly work:
#rownames(SNPpos) = apply(cbind(tumorcounts[,1], tumorcounts[,2]), 1, paste, collapse="_")
#This is for compatibility with gc correction file

colnames(SNPpos) = c("Chr","Position")
SNPpos[,1] = as.vector(normalcounts[,1])
SNPpos[,2] = normalcounts[,2]

#Caclulate BAF
Tumor_BAF = matrix(nrow = dim(normalcounts)[1],ncol = 1)
rownames(Tumor_BAF) = rownames(SNPpos)
colnames(Tumor_BAF) = c(tumorid)
acgt = tumorcounts[,c(3:6)]
acgts = t(apply(acgt,1,sort))
Tumor_BAF[,1] = acgts[,4]/(acgts[,3]+acgts[,4])
Tumor_BAF[,1] = ifelse(runif(length(Tumor_BAF[,1]))<0.5,Tumor_BAF[,1],1-Tumor_BAF[,1])
Tumor_BAF[is.nan(Tumor_BAF)]=NA

Germline_BAF = matrix(nrow = dim(normalcounts)[1],ncol = 1)
rownames(Germline_BAF) = rownames(SNPpos)
colnames(Germline_BAF) = c(normalid)
acgt = normalcounts[,c(3:6)]
acgts = t(apply(acgt,1,sort))
Germline_BAF[,1] = acgts[,4]/(acgts[,3]+acgts[,4])
Germline_BAF[,1] = ifelse(runif(length(Germline_BAF[,1]))<0.5,Germline_BAF[,1],1-Germline_BAF[,1])
Germline_BAF[is.nan(Germline_BAF)]=NA

Tumor_LogR = matrix(nrow = dim(normalcounts)[1],ncol = 1)
Germline_LogR = matrix(nrow = dim(normalcounts)[1],ncol = 1)
rownames(Tumor_LogR) = rownames(SNPpos)
colnames(Tumor_LogR) = c(tumorid)
rownames(Germline_LogR) = rownames(SNPpos)
colnames(Germline_LogR) = c(normalid)
Tumor_LogR[,1] = log(tumorcounts[,7]/normalcounts[,7],2)
Germline_LogR[,1] = 0
Tumor_LogR[is.infinite(Tumor_LogR)]=NA
if(gender=="XY") {
    Tumor_LogR[SNPpos[,1]=="X",1] = Tumor_LogR[SNPpos[,1]=="X",1]-1
    Germline_LogR[SNPpos[,1]=="X",1] = Germline_LogR[SNPpos[,1]=="X",1]-1
}
Tumor_LogR[,1] = Tumor_LogR[,1] - median(Tumor_LogR[,1],na.rm=T)
# set regions with 0 reads in tumor and normal to a LogR of 0.
Tumor_LogR[is.na(Tumor_LogR[,1]),1] = 0

# limit the number of digits:
Tumor_LogR = round(Tumor_LogR,4)
Tumor_BAF = round(Tumor_BAF,4)
Germline_LogR = round(Germline_LogR,4)
Germline_BAF = round(Germline_BAF,4)

# write output to files
write.table(cbind(SNPpos,Tumor_LogR),paste(tumorid,".LogR",sep=""),sep="\t",row.names=T,col.names=NA,quote=F)
write.table(cbind(SNPpos,Tumor_BAF),paste(tumorid,".BAF",sep=""),sep="\t",row.names=T,col.names=NA,quote=F)
write.table(cbind(SNPpos,Germline_LogR),paste(normalid,".LogR",sep=""),sep="\t",row.names=T,col.names=NA,quote=F)
write.table(cbind(SNPpos,Germline_BAF),paste(normalid,".BAF",sep=""),sep="\t",row.names=T,col.names=NA,quote=F)


df<-as.matrix(read.table("C:/Users/Xie-lab/Desktop/imputation/retina_analysis/ds1/merge/ds0.3_Jaccard.txt",row.names=1,header=T,sep="\t"))
df <-df[,-8]
df1 <-df[1:7,]
rownames(df1) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df1) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df1 <-melt(df1)
df2 <-df[8:14,]
rownames(df2) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df2) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df2 <-melt(df2)
df3 <-df[15:21,]
rownames(df3) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df3) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df3 <-melt(df3)
df4 <-df[22:28,]
rownames(df4) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df4) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df4 <-melt(df4)
df5 <-df[29:35,]
rownames(df5) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df5) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df5 <-melt(df5)

dff <-rbind(df1,df2,df3,df4,df5)
dff1 <- data_summary(dff, varname="value", groupnames=c("Var1", "Var2"))

dff1$Var1 <-factor(dff1$Var1,levels =c("scVI","scScope","DCA","MAGIC","SAVER","DeSCI","RAW"))
p <-ggplot(data = dff1, aes(x=Var2, y=Var1, fill=value))+ geom_tile()+ labs(x="Method", y = "Cell Type")+theme_classic()
p <-p +theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+theme(axis.text.y = element_text(size = 12, hjust = 1, vjust = 1, face = "bold"))
p +scale_fill_gradient(low='white',high='red')+theme(legend.title=element_blank()) +geom_text(aes(Var2, Var1, label = round(value,2)), color = "black", size = 4)
#############
df<-as.matrix(read.table("C:/Users/Xie-lab/Desktop/imputation/retina_analysis/ds1/merge/ds0.5_Jaccard.txt",row.names=1,header=T,sep="\t"))
df <-df[,-8]
df1 <-df[1:7,]
rownames(df1) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df1) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df1 <-melt(df1)
df2 <-df[8:14,]
rownames(df2) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df2) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df2 <-melt(df2)
df3 <-df[15:21,]
rownames(df3) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df3) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df3 <-melt(df3)
df4 <-df[22:28,]
rownames(df4) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df4) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df4 <-melt(df4)
df5 <-df[29:35,]
rownames(df5) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df5) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df5 <-melt(df5)

dff <-rbind(df1,df2,df3,df4,df5)
dff1 <- data_summary(dff, varname="value", groupnames=c("Var1", "Var2"))

dff1$Var1 <-factor(dff1$Var1,levels =c("scVI","scScope","DCA","MAGIC","SAVER","DeSCI","RAW"))
p <-ggplot(data = dff1, aes(x=Var2, y=Var1, fill=value))+ geom_tile()+ labs(x="Method", y = "Cell Type")+theme_classic()
p <-p +theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+theme(axis.text.y = element_text(size = 12, hjust = 1, vjust = 1, face = "bold"))
p +scale_fill_gradient(low='white',high='red')+theme(legend.title=element_blank()) +geom_text(aes(Var2, Var1, label = round(value,2)), color = "black", size = 4)

###########

df<-as.matrix(read.table("C:/Users/Xie-lab/Desktop/imputation/retina_analysis/ds1/merge/ds0.3_F1.txt",row.names=1,header=T,sep="\t"))
df <-df[,-8]
df1 <-df[1:7,]
rownames(df1) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df1) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df1 <-melt(df1)
df2 <-df[8:14,]
rownames(df2) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df2) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df2 <-melt(df2)
df3 <-df[15:21,]
rownames(df3) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df3) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df3 <-melt(df3)
df4 <-df[22:28,]
rownames(df4) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df4) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df4 <-melt(df4)
df5 <-df[29:35,]
rownames(df5) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df5) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df5 <-melt(df5)

dff <-rbind(df1,df2,df3,df4,df5)
dff1 <- data_summary(dff, varname="value", groupnames=c("Var1", "Var2"))

dff1$Var1 <-factor(dff1$Var1,levels =c("scVI","scScope","DCA","MAGIC","SAVER","DeSCI","RAW"))
p <-ggplot(data = dff1, aes(x=Var2, y=Var1, fill=value))+ geom_tile()+ labs(x="Method", y = "Cell Type")+theme_classic()
p <-p +theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+theme(axis.text.y = element_text(size = 12, hjust = 1, vjust = 1, face = "bold"))
p +scale_fill_gradient(low='white',high='red')+theme(legend.title=element_blank()) +geom_text(aes(Var2, Var1, label = round(value,2)), color = "black", size = 4)
#############
df<-as.matrix(read.table("C:/Users/Xie-lab/Desktop/imputation/retina_analysis/ds1/merge/ds0.5_F1.txt",row.names=1,header=T,sep="\t"))
df <-df[,-8]
df1 <-df[1:7,]
rownames(df1) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df1) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df1 <-melt(df1)
df2 <-df[8:14,]
rownames(df2) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df2) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df2 <-melt(df2)
df3 <-df[15:21,]
rownames(df3) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df3) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df3 <-melt(df3)
df4 <-df[22:28,]
rownames(df4) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df4) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df4 <-melt(df4)
df5 <-df[29:35,]
rownames(df5) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df5) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df5 <-melt(df5)

dff <-rbind(df1,df2,df3,df4,df5)
dff1 <- data_summary(dff, varname="value", groupnames=c("Var1", "Var2"))

dff1$Var1 <-factor(dff1$Var1,levels =c("scVI","scScope","DCA","MAGIC","SAVER","DeSCI","RAW"))
p <-ggplot(data = dff1, aes(x=Var2, y=Var1, fill=value))+ geom_tile()+ labs(x="Method", y = "Cell Type")+theme_classic()
p <-p +theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+theme(axis.text.y = element_text(size = 12, hjust = 1, vjust = 1, face = "bold"))
p +scale_fill_gradient(low='white',high='red')+theme(legend.title=element_blank()) +geom_text(aes(Var2, Var1, label = round(value,2)), color = "black", size = 4)

######
df<-as.matrix(read.table("C:/Users/Xie-lab/Desktop/imputation/retina_analysis/ds1/merge_ds/ds0.7_Jaccard.txt",row.names=1,header=T,sep="\t"))
df <-df[,-8]
df1 <-df[1:7,]
rownames(df1) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df1) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df1 <-melt(df1)
df2 <-df[8:14,]
rownames(df2) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df2) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df2 <-melt(df2)
df3 <-df[15:21,]
rownames(df3) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df3) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df3 <-melt(df3)
df4 <-df[22:28,]
rownames(df4) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df4) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df4 <-melt(df4)
df5 <-df[29:35,]
rownames(df5) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df5) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df5 <-melt(df5)

dff <-rbind(df1,df2,df3,df4,df5)
dff1 <- data_summary(dff, varname="value", groupnames=c("Var1", "Var2"))

dff1$Var1 <-factor(dff1$Var1,levels =c("scVI","scScope","DCA","MAGIC","SAVER","DeSCI","RAW"))
p <-ggplot(data = dff1, aes(x=Var2, y=Var1, fill=value))+ geom_tile()+ labs(x="Method", y = "Cell Type")+theme_classic()
p <-p +theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+theme(axis.text.y = element_text(size = 12, hjust = 1, vjust = 1, face = "bold"))
p +scale_fill_gradient(low='white',high='red')+theme(legend.title=element_blank()) +geom_text(aes(Var2, Var1, label = round(value,2)), color = "black", size = 4)

df<-as.matrix(read.table("C:/Users/Xie-lab/Desktop/imputation/retina_analysis/ds1/merge_ds/ds0.7_F1.txt",row.names=1,header=T,sep="\t"))
df <-df[,-8]
df1 <-df[1:7,]
rownames(df1) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df1) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df1 <-melt(df1)
df2 <-df[8:14,]
rownames(df2) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df2) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df2 <-melt(df2)
df3 <-df[15:21,]
rownames(df3) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df3) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df3 <-melt(df3)
df4 <-df[22:28,]
rownames(df4) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df4) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df4 <-melt(df4)
df5 <-df[29:35,]
rownames(df5) <-c("RAW","DeSCI","SAVER","DCA","MAGIC","scScope","scVI")
colnames(df5) <-c("HC","RGC","Amacrine cells","Cones","Bipolar","Muller glia","Astrocytes","VE","Pericytes","Microglia","Rods")
df5 <-melt(df5)

dff <-rbind(df1,df2,df3,df4,df5)
dff1 <- data_summary(dff, varname="value", groupnames=c("Var1", "Var2"))

dff1$Var1 <-factor(dff1$Var1,levels =c("scVI","scScope","DCA","MAGIC","SAVER","DeSCI","RAW"))
p <-ggplot(data = dff1, aes(x=Var2, y=Var1, fill=value))+ geom_tile()+ labs(x="Method", y = "Cell Type")+theme_classic()
p <-p +theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+theme(axis.text.y = element_text(size = 12, hjust = 1, vjust = 1, face = "bold"))
p +scale_fill_gradient(low='white',high='red')+theme(legend.title=element_blank()) +geom_text(aes(Var2, Var1, label = round(value,2)), color = "black", size = 4)


# II. Dynamic Programming: the scoring function is interpreted
fragment_inty <- function(probe, cores = 1, pen, pen_out) {
    num_args <- list(pen, pen_out)
    names(num_args) <- c("pen", "pen_out")
    # assert(
    #     all(unlist(lapply(
    #         num_args,
    #         FUN = function(x) {
    #             (is.numeric(x) &
    #                  length(x) == 1)
    #         }
    #     ))),
    #     paste0(
    #         "'",
    #         names(which(unlist(
    #             lapply(
    #                 num_args,
    #                 FUN = function(x) {
    #                     (is.numeric(x) &
    #                          length(x) == 1)
    #                 }
    #             )
    #         ) == FALSE))[1],
    #         "' must be numeric of length one or given by the logs"
    #     )
    # )
    # assert(cores > 0, "'cores' must be a positive integer")
    # req_cols_probe <- c("ID", "HL_fragment", "intensity")
    # assert(
    #     all(req_cols_probe %in% colnames(probe)),
    #     paste0("'", req_cols_probe[which(
    #         !req_cols_probe %in% colnames(probe))], "' must be a column in 'probe'!")
    # )

    # I.Preparations: the dataframe is configured and some other variables
    # are assigned

    registerDoMC(cores)

    probe <- probe[with(probe, order(-xtfrm(probe$strand), probe$position)), ]

    probe[probe$strand == "-", ] <-
        probe[probe$strand == "-", ][order(probe[probe$strand == "-",
        ]$position, decreasing = TRUE), ]

    probe[, "intensity_comb_fragment"] <- NA
    probe[, "intensity_mean_comb_fragment"] <- NA

    # here the assigned penalty is cached to be changed dynamically in the loop
    tmp_df <-
        data.frame(
            ID = probe$ID,
            val = probe$distance_int,
            seg = probe$position_segment
        )

    # here it is important that (terminal) outliers and NAs are considered, as all
    # bins have an intensity that needs to be grouped.
    tmp_df[, "seg"] <- gsub("_O|_NA", "", tmp_df$seg)

    # this is just for safety, nothing should be omitted here
    tmp_df <- na.omit(tmp_df)

    #tmp_df$val <- log2(tmp_df$val)

    unique_seg <- unlist(unique(tmp_df$seg))

    count <- 1

    # II. Dynamic Programming: the scoring function is interpreted

    frags <- foreach(k = seq_along(unique_seg)) %dopar% {
        section <- tmp_df[which(tmp_df$seg == unique_seg[k]), ]

        best_frags <- c()
        best_names <- c()

        if (nrow(section) > 1) {
            # only segments with more than one value are grouped...*

            for (i in 2:nrow(section)) {
                tmp_score <-
                    score_fun_ave(section[seq_len(i), "val"],
                                  section[seq_len(i), "ID"], pen_out)
                tmp_name <- names(tmp_score)
                if (i > 3) {
                    for (j in (i - 1):3) {
                        tmp_val <- section[j:i, "val"]
                        tmp_ID <- section[j:i, "ID"]
                        tmp <-
                            score_fun_ave(tmp_val, tmp_ID, pen_out) + pen + best_frags[j - 2]
                        tmp_score <- c(tmp_score, tmp)
                        tmp_n <- paste0(best_names[j - 2], "|", names(tmp))
                        tmp_name <- c(tmp_name, tmp_n)
                    }
                }
                pos <- which(tmp_score == min(tmp_score))[1]
                tmp_score <- tmp_score[pos]
                tmp_name <- tmp_name[pos]
                best_frags <- c(best_frags, tmp_score)
                best_names <- c(best_names, tmp_name)
            }
        } else {
            #* ...all segments with less than two values are grouped automatically
            tmp_score <-
                score_fun_ave(section[, "val"], section[, "ID"], pen_out)
            tmp_name <- names(tmp_score)
            best_names <- c(best_names, tmp_name)
        }
        best_names[length(best_names)]
    }

    # III. Fill the dataframe

    for (k in seq_along(frags)) {
        na <- strsplit(frags[[k]], "\\|")[[1]]
        for (i in seq_along(na)) {
            tmp_trgt <- strsplit(na[i], "_")[[1]][1]
            trgt <- strsplit(tmp_trgt, ",")[[1]]
            if (length(strsplit(na[i], "_")[[1]]) == 3) {
                tmp_outl <- strsplit(na[i], "_")[[1]][3]
                outl <- strsplit(tmp_outl, ",")[[1]]
                trgt <- trgt[-which(trgt %in% outl)]
                rows <- match(outl, probe[, "ID"])
                nam <- paste0("I_", count, "_O")
                probe[rows, "intensity_comb_fragment"] <- nam
                # the mean needs to be reverted by the correction factor here
                probe[rows, "intensity_mean_comb_fragment"] <- (as.numeric(strsplit(na[i], "_")[[1]][2]))
            }
            rows <- match(trgt, probe[, "ID"])
            nam <- paste0("I_", count)
            probe[rows, "intensity_comb_fragment"] <- nam
            # the mean needs to be reverted by the correction factor here
            probe[rows, "intensity_mean_comb_fragment"] <-
                (as.numeric(strsplit(na[i], "_")[[1]][2]))
            count <- count + 1
        }
    }

    if (sum(cumprod(is.na(probe$intensity_comb_fragment))) > 0) {
        probe$intensity_comb_fragment[seq_len(
            sum(cumprod(is.na(probe$intensity_comb_fragment))))] <- "I_0.5_NA"
    }
    row_NA <- which(is.na(probe$intensity_comb_fragment))
    if (length(row_NA) > 0) {
        group <- c(row_NA[1])
        for (i in seq_along(row_NA)) {
            if (is.na(probe$intensity_comb_fragment[row_NA[i] + 1])) {
                group <- c(group, row_NA[i] + 1)
            } else if (gsub("_O", "", probe$intensity_comb_fragment[group[1] - 1]) ==
                       gsub("_O", "", probe$intensity_comb_fragment[group[length(group)] + 1])) {
                probe$intensity_comb_fragment[group] <-
                    paste0(gsub("_O", "", probe$intensity_comb_fragment[group[1] - 1]), "_NA")
                probe$intensity_mean_comb_fragment[group] <-
                    probe$intensity_mean_comb_fragment[group[1] - 1]
                group <- row_NA[i + 1]
            } else if (probe$intensity_comb_fragment[group[1] - 1] !=
                       probe$intensity_comb_fragment[group[length(group)] + 1]) {
                probe$intensity_comb_fragment[group] <-
                    paste0("I_", as.numeric(gsub(
                        "I_|_O", "", probe$intensity_comb_fragment[group[1] - 1]
                    )) + 0.5, "_NA")
                group <- row_NA[i + 1]
            }
        }
        probe$intensity_comb_fragment[is.na(probe$intensity_comb_fragment)] <-
            paste0("I_", as.numeric(gsub(
                "I_|_O", "", probe$intensity_comb_fragment[!is.na(probe$intensity_comb_fragment)]
                [length(probe$intensity_comb_fragment[!is.na(probe$intensity_comb_fragment)])]
            )) + 0.5, "_NA")
    }
    probe
}


# R script to summarize PreservationSimulation/shelf data
# All the grouping and aggregation dependent code should go in here.
#  And there will be one of these files for various combinations of
#  grouping and aggregation.
#
# 20141214 RBLandau original version.
# . . . revised many times . . .
# 20170310  RBL Extract summarize function from larger script.
# 20170312  RBL Also extract table calcs and detailed stats printer.
# 20170318  RBL Add percentage loss table for midmeans.
#
#

# f n S e l e c t C o l u m n s
# What data items are we going to be analyzing by grouping and aggregation?
# Return a new data frame containing only those.  They will be used in
#  all the summarization and detailed stats functions below.
fnSelectColumns <- function(dat)
{
    datn <- data.frame(dat$docsize,dat$glitchimpact,dat$lifem,dat$copies,dat$lost)
    return(datn)
}

# s u m m a r i z e
# There will be different version of this function for each of
#  several sets of groupings.
#  This one is glitch-docsize.
#
summarize <- function(myframe,mysummaryout,mysummaryfunction)
{
    # NOTE: colnames and newrow declarations must be in the same order.
    colnames(mysummaryout) <- c("docsize","glitchimpact","lifem","c1","c2","c3","c4","c5","c8")

    for (gi in levels(factor(myframe$dat.glitchimpact)))
    {
        tmp1 <- data.frame(myframe[myframe$dat.glitchimpact==gi,]);
        for (ds in levels(factor(tmp1$dat.docsize)))
        {
            tmp2 <- data.frame(tmp1[tmp1$dat.docsize==ds,]);
            for (lfm in levels(factor(tmp2$dat.lifem)))
            {
                tmp3 <- tmp2[tmp2$dat.lifem==lfm,]
                tmp4 <- aggregate(tmp3, by=list(tmp3$dat.copies), FUN=mysummaryfunction)
                # NOTE: The columns will print in this order.
                newrow <- c(ds,gi,lfm,round(tmp4$dat.lost,2))

                if (length(newrow) < length(colnames(mysummaryout)))
                {
                    filler <- rep(0,length(colnames(mysummaryout)) - length(newrow))
                    #print(c(length(filler),"=>",filler))
                    #print(c(length(newrow),"=>",newrow))
                    newrow <- c(newrow,filler)
                }
                #print(newrow)

                # Absurd hack in here to make lifem print reasonably.
                #  Increase the penalty for printing in scientific
                #  (exponential) format, and limit the number of digits
                #  so that there are no places after the radix point.
                # BEWARE of column order dependency here!!!
                colnames(mysummaryout)[3] <- "   lifem"
                options("scipen"=100, "digits"=1)
                # End of absurd hack.
                mysummaryout <- rbind(mysummaryout,as.numeric(newrow))
            }
        }
    }
    mysummaryout <- mysummaryout[-1,]
    rownames(mysummaryout) <- NULL
    rownames(mysummaryout, do.NULL = TRUE, prefix = "row")
    return(mysummaryout)
}#ENDFN summarize

# T A B L E S

# f n T a b l e M i d
fnTableMid <- function(dat)
{
    if(TRUE){
        # Summary table with midmeans.
        xsummid <- data.frame(rbind(numeric(9)))
        #colnames(xsummid) <- c("docsize","glitchimpact","lifem","c1","c2","c3","c4","c5","c8")
        #datn = data.frame(dat$docsize,dat$lifem,dat$glitchimpact,dat$copies,dat$lost)
        dat2 <- data.frame(dat$docsize,dat$lifem,dat$copies,dat$lost,dat$auditfrequency,dat$glitchfreq,dat$glitchimpact)
        datn <- dat2[dat2$dat.copies<=8,]
        tsummid <- summarize(datn,xsummid,midmean)
        return(tsummid)
    }#ENDIFFALSE
}#ENDFN fnTableMid

# f n T a b l e M i d P c t
fnTableMidPct <- function(dat)
{
    if(TRUE){
        # Summary table with midmeans.
        tsummid <- fnTableMid(dat)
        for (col in c('c1','c2','c3','c4','c5','c8'))
        {
            # Convert loss numberss to percentages of collection size.
            tsummid[,col] <- tsummid[,col] / nDocs * 100.0
        }
        return(tsummid)
    }#ENDIFFALSE
}#ENDFN fnTableMid

# f n T a b l e M e d
fnTableMed <- function(dat)
{
    if(1){
        # Summary table with medians.
        xsummed <- data.frame(rbind(numeric(9)))
        colnames(xsummed) <- c("docsize","glitchimpact","lifem","c1","c2","c3","c4","c5","c8")
        dat2 <- data.frame(dat$docsize,dat$lifem,dat$copies,dat$lost,dat$auditfrequency,dat$glitchfreq,dat$glitchimpact)
        datn <- dat2[dat2$dat.copies<=8,]
        tsummed <- summarize(datn,xsummed,median)
        return(tsummed)
    }#ENDIFFALSE
}#ENDFN fnTableMed

# f n T a b l e T r i
fnTableTri <- function(dat){
    if(1){
        # Summary table with trimeans.
        xsumtri <- data.frame(rbind(numeric(9)))
        colnames(xsumtri) <- c("docsize","glitchimpact","lifem","c1","c2","c3","c4","c5","c8")
        dat2 <- data.frame(dat$docsize,dat$lifem,dat$copies,dat$lost,dat$auditfrequency,dat$glitchfreq,dat$glitchimpact)
        datn <- dat2[dat2$dat.copies<=8,]
        tsumtri <- summarize(datn,xsumtri,trimean)
        return(tsumtri)
    }#ENDIFFALSE
}#ENDFN fnTableTri

# f n D e t a i l e d S a m p l e S t a t s
fnDetailedSampleStats <- function(datn)
{
    # The order of nesting here makes some comparisons easier than others.
    for (ds in levels(factor(datn$dat.docsize)))
    {
        tmp1 <- data.frame(datn[datn$dat.docsize==ds,]);
        for (lfm in levels(factor(tmp1$dat.lifem)))
        {
            tmp2 <- tmp1[tmp1$dat.lifem==lfm,]
            for (cp in levels(factor(tmp2$dat.copies)))
            {
                tmp3 <- tmp2[tmp2$dat.copies==cp,]
                for (gi in levels(factor(tmp3$dat.glitchimpact)))
                {
                    tmp4 <- tmp3[tmp3$dat.glitchimpact==gi,]
                    WhateverSampleSadisticsYouWant("docsize",ds,"lifem",lfm,"copies",cp,"glitchimpact",gi,tmp4$dat.lost)
                }
            }
        }
    }
}#ENDFN fnDetailedSampleStats

#END


# GetShockData_high_span2.r
#                                       RBLandau 20180129
# where to run?
# setwd("C:/cygwin64/home/landau/working/PreservationSimulation/shocks/high/span2")
#
# For copies=3,4,5,6: what are the failure rates at shock span2?
#

source("./DataUtil.r")
source("./PlotUtil.r")

# G E T   D A T A
if (exists("results")) {rm(results)}
results <- fndfGetGiantData("./")
# Get fewer columns to work with, easier to see.
dat.shockallcopies <- as.data.frame(fndfGetShockData(results))
dat.shockall <- dat.shockallcopies[dat.shockallcopies$copies>=3
                & dat.shockallcopies$copies<=6,]

# S U B S E T S

if (nrow(dat.shockall) > 0)
{
    source("./ShockLowPlots.r")

    # freq 1yr dur 6mo
    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==2
                        & dat.shockall$shockfreq==10000
                        & dat.shockall$shockmaxlife==5000
                        & dat.shockall$shockimpact==50,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=1, nDuration=6, nSpan=2, nImpact=50)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq1yr_dur6mo_span2_impact50.png")

    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==2
                        & dat.shockall$shockfreq==10000
                        & dat.shockall$shockmaxlife==5000
                        & dat.shockall$shockimpact==80,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=1, nDuration=6, nSpan=2, nImpact=80)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq1yr_dur6mo_span2_impact80.png")

    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==2
                        & dat.shockall$shockfreq==10000
                        & dat.shockall$shockmaxlife==5000
                        & dat.shockall$shockimpact==100,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=1, nDuration=6, nSpan=2, nImpact=100)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq1yr_dur6mo_span2_impact100.png")

    # freq 1yr dur 12mo
    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==2
                        & dat.shockall$shockfreq==10000
                        & dat.shockall$shockmaxlife==10000
                        & dat.shockall$shockimpact==50,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=1, nDuration=12, nSpan=2, nImpact=50)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq1yr_dur12mo_span2_impact50.png")

    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==2
                        & dat.shockall$shockfreq==10000
                        & dat.shockall$shockmaxlife==10000
                        & dat.shockall$shockimpact==80,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=1, nDuration=12, nSpan=2, nImpact=80)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq1yr_dur12mo_span2_impact80.png")

    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==2
                        & dat.shockall$shockfreq==10000
                        & dat.shockall$shockmaxlife==10000
                        & dat.shockall$shockimpact==100,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=1, nDuration=12, nSpan=2, nImpact=100)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq1yr_dur12mo_span2_impact100.png")

}

# Unwind any remaining sink()s to close output files.
while (sink.number() > 0) {sink()}

#END


## sample of what the table looks like

     GroupID                Category       Term                                             Description      LogP Log.q.value.
1  1_Summary GO Biological Processes GO:0016054                          organic acid catabolic process -2.968393   0.00000000
2  2_Summary GO Biological Processes GO:1903532                positive regulation of secretion by cell -2.583714   0.00000000
3  3_Summary GO Biological Processes GO:0043009                          chordate embryonic development -2.053961   0.00000000
4   2_Member GO Biological Processes GO:0099519               dense core granule cytoskeletal transport -3.311542  -0.04275441
5   2_Member GO Biological Processes GO:0060025                         regulation of synaptic activity -2.834613  -0.04275441
6  1_Summary GO Biological Processes GO:0051056 regulation of small GTPase mediated signal transduction -3.458737   0.00000000
7   2_Member GO Biological Processes GO:0050848                regulation of calcium-mediated signaling -3.025228   0.00000000
8  3_Summary GO Biological Processes GO:0032970              regulation of actin filament-based process -3.191542   0.00000000
9  5_Summary GO Biological Processes GO:0060485                                  mesenchyme development -2.161390   0.00000000
10 1_Summary GO Biological Processes GO:0007435                            salivary gland morphogenesis -4.291400  -0.31108379
11  2_Member GO Biological Processes GO:0021917                    somatic motor neuron fate commitment -3.463333  -0.31108379
12  1_Member GO Biological Processes GO:0006935                                              chemotaxis -3.058766  -0.31108379
13  2_Member GO Biological Processes GO:0061072                                      iris morphogenesis -2.509614  -0.21880009
14 3_Summary GO Biological Processes GO:0090292            nuclear matrix anchoring at nuclear membrane -2.986342  -0.31108379
15 6_Summary GO Biological Processes GO:0019388                             galactose catabolic process -2.463921  -0.18909608
16 5_Summary GO Biological Processes GO:0015886                                          heme transport -2.509614  -0.21880009
   InTerm_InList                    Genes                     Symbols            Type
1          3/267 3373,6342,8372,3981,9446 HYAL1,SCP2,HYAL3,LIG4,GSTO1    Diencephalon
2          3/364           43,8372,399687           ACHE,HYAL3,MYO18A    Diencephalon
3          3/564          3373,3981,10395             HYAL1,LIG4,DLC1    Diencephalon
4            1/1                    55638                        SYBU Cerebral_Cortex
5            1/3                    55638                        SYBU Cerebral_Cortex
6          3/307     3084,3925,58480,2009        NRG1,STMN1,RHOU,EML1 Cerebral_Cortex
7           2/98                3084,5144                  NRG1,PDE4D Cerebral_Cortex
8          3/379          3925,5144,58480            STMN1,PDE4D,RHOU Cerebral_Cortex
9          2/270               3084,60412                  NRG1,EXOC4 Cerebral_Cortex
10          2/32         5080,10371,57509           PAX6,SEMA3A,MTUS1      Cerebellum
11           1/1                     5080                        PAX6      Cerebellum
12         3/601         5080,10371,57509           PAX6,SEMA3A,MTUS1      Cerebellum
13           1/9                     5080                        PAX6      Cerebellum
14           1/3                    23345                       SYNE1      Cerebellum
15          1/10                     5236                        PGM1      Cerebellum
16           1/9                     9429                       ABCG2      Cerebellum

## plotting code
library(ggplot2)
ggplot(bp, aes(x=-1*LogP, y=factor(Description))) +
       geom_point(aes(size=-1*LogP,color=Type)) +
       facet_wrap(~Type) +
       xlim(1.2, 4.7) +
       scale_size(range = c(3,6.6)) +
       theme_bw() +
       theme(axis.text.y = element_text(size = 12))

## Scatter plot
save.image("~/Go/Gop/Btissue_session.RData")
load("~/ennan/hNSC_and_Somatics/Scr_SATS/geneExprDistribution/scatter/scatter.RData")

p2 + geom_point(aes(F2$NSC_FPKM, F2$Somatic_FPKM), color="#FF6A6A", size=2.3) +
     geom_point(aes(Fls2$NSC_FPKM, Fls2$Somatic_FPKM), size= 1.2, color="orange") +
     theme_bw() +
     scale_y_continuous(breaks = c(0,2,4,6,8,10)) +
     scale_x_continuous(breaks = c(0,2,4,6,8,10)) +
     coord_cartesian(ylim = c(0,10), xlim = c(0,10))


extract_time_from_nanos <- function (data_read) {
    # Normalized iteration time.
    column_time <- data_read [['nanos']] / 1e9

    return (column_time)
}

extract_time_from_duration <- function (data_read) {
    # Normalized iteration time.
    column_time <- data_read [['duration_ns']] / 1e9

    return (column_time)
}

extract_cumulative_time_from_uptime <- function (data_read) {
    # Normalized cumulative time.
    column_total <- (data_read [['uptime_ns']] + data_read [['duration_ns']]) / 1e9

    return (column_total)
}

normalize_columns <- function (data_read) {
    # Replace certain characters in column  names.
    data_normalized <- rename_all (data_read, function (name) str_replace_all (name, '[-:]', '_'))

    return (data_normalized)
}

compute_index <- function (data_read) {
    # Sequential repetition index.
    column_index <- seq.int (1, nrow (data_read))

    return (column_index)
}

compute_cumulative_time_from_unix <- function (data_read) {
    # Compute cumulative time.
    # We only have second resolution timestamps
    # so we use those to stretch cumulative time.
    column_time <- data_read [['nanos']] / 1e9
    column_total <- cumsum (column_time)
    time_nano_interval <- last (column_total)
    time_unix_beg <- first (data_read [['unixts.before']])
    time_unix_end <- last (data_read [['unixts.after']])
    time_unix_interval <- (time_unix_end - time_unix_beg) / 1e3
    time_scale <- time_unix_interval / time_nano_interval
    column_total <- column_total * time_scale

    return (column_total)
}

extract_data_version_2 <- function (data_json, benchmark) {

    data_read <- as_tibble (data_json [['results']] [[benchmark]])
    assert_that (is_tibble (data_read))
    assert_that (nrow (data_read) > 0)

    # Transform basic columns into canonical form.
    column_time <- extract_time_from_nanos (data_read)
    column_total <- compute_cumulative_time_from_unix (data_read)
    column_index <- compute_index (data_read)

    # Preserve optional columns not transformed into canonical form.
    data_extra <- normalize_columns (select (data_read, -nanos, -unixts.before, -unixts.after))

    return (bind_cols (tibble (time = column_time, total = column_total, index = column_index), data_extra))
}

extract_data_version_4 <- function (data_json, benchmark) {

    data_read <- as_tibble (data_json [['data']] [[benchmark]] [['results']])
    assert_that (is_tibble (data_read))
    assert_that (nrow (data_read) > 0)

    # Transform basic columns into canonical form.
    column_time <- extract_time_from_nanos (data_read)
    column_total <- compute_cumulative_time_from_unix (data_read)
    column_index <- compute_index (data_read)

    # Preserve optional columns not transformed into canonical form.
    data_extra <- normalize_columns (select (data_read, -nanos, -unixts.before, -unixts.after))

    return (bind_cols (tibble (time = column_time, total = column_total, index = column_index), data_extra))
}

extract_data_version_5 <- function (data_json, benchmark) {

    data_read <- as_tibble (data_json [['data']] [[benchmark]] [['results']])
    assert_that (is_tibble (data_read))
    assert_that (nrow (data_read) > 0)

    # Transform basic columns into canonical form.
    column_time <- extract_time_from_duration (data_read)
    column_total <- extract_cumulative_time_from_uptime (data_read)
    column_index <- compute_index (data_read)

    # Preserve optional columns not transformed into canonical form.
    data_extra <- normalize_columns (select (data_read, -duration_ns, -uptime_ns))

    return (bind_cols (tibble (time = column_time, total = column_total, index = column_index), data_extra))
}

#' Load data from given directory.
#'
#' @param data_path data directory to load from
#' @return tibble with loaded data
load_data_json <- function (data_path) {

    log_info ('Loading data from {data_path} ...')

    result <- tibble (
        vm_name = factor (),
        vm_version = factor (),
        vm_configuration = factor (),
        benchmark = factor (),
        run = factor ())

    data_file_list <- list.files (data_path, '\\.json(|\\.gz|\\.xz|\\.bz2)$', recursive = TRUE, full.names = TRUE)
    for (data_file_name in data_file_list) {

        data_json <- fromJSON (data_file_name)

        version <- data_json [['format_version']]

        meta_vm_name <- get_with_default (data_json, 'Unknown Name', 'environment', 'vm', 'name')
        meta_vm_version <- get_with_default (data_json, 'Unknown Version', 'environment', 'vm', 'version')
        meta_vm_configuration <- paste (get_with_default (data_json, 'Unknown Arguments', 'environment', 'vm', 'args'), collapse = ' ')

        # Lacking better source the file name is good run id.
        meta_run_name <- data_file_name

        meta_benchmark_list <- data_json [['benchmarks']]
        for (meta_benchmark_name in meta_benchmark_list) {

            data_read <- NULL
            if (version == 2) data_read <- extract_data_version_2 (data_json, meta_benchmark_name)
            if (version == 4) data_read <- extract_data_version_4 (data_json, meta_benchmark_name)
            if (version == 5) data_read <- extract_data_version_5 (data_json, meta_benchmark_name)

            if (!is_tibble (data_read) || nrow (data_read) == 0) {
                log_warn ('Results for benchmark {meta_benchmark_name} in file {data_file_name} damaged.')
                next
            }

            # Put everything together.
            data_read [['run']] <- factor (meta_run_name)
            data_read [['vm_name']] <- factor (meta_vm_name)
            data_read [['vm_version']] <- factor (meta_vm_version)
            data_read [['vm_configuration']] <- factor (meta_vm_configuration)
            data_read [['benchmark']] <- factor (meta_benchmark_name)

            result <- bind_rows_with_factor_merger (result, data_read, c ('vm_name', 'vm_version', 'vm_configuration', 'run', 'benchmark'))
        }
    }

    log_info ('... loaded {nrow (result)} points in {nlevels (result [["run"]])} runs.')

    return (result)
}


\docType{data}
\name{bateadores}
\alias{bateadores}
\title{Tabla de estadísticas de bateo}
\format{Un data frame con 105.861 filas y 22 columnas
\describe{
\item{id_jugador}{ID del jugador}
\item{id_anio}{Año}
\item{orden_equipos}{Orden en que el jugador se movió entre equipos dentro de la misma temporada}
\item{id_equipo}{ID del equipo (factor)}
\item{id_liga}{ID de la liga (factor con niveles AA, AL, FL, NL, PL, UA)}
\item{juegos}{Número de juegos en los que participó oficialmente el jugador}
\item{al_bate}{Turnos al bate}
\item{carreras}{Carreras anotadas}
\item{golpes}{Cantidad de veces en la que el jugador alcanzó una base debido a un golpe, sin error de la defensa}
\item{dobles}{Hits en los que el bateador llegó a segunda base}
\item{triples}{Golpes en los que el bateador llegó a tercera base}
\item{cuadrangulares}{Cuadrangulares - jonrones}
\item{carreras_empujadas}{Carreras empujadas}
\item{bases_robadas}{Bases robadas}
\item{atrapado_robando}{Atrapado (out) en intento de robo}
\item{base_bolas}{Base por bolas}
\item{ponches}{Ponches}
\item{base_intencional}{Base por bolas intencional}
\item{golpeado}{Golpeado por lanzamiento}
\item{toque_sacrificio}{Toque de sacrificio}
\item{elavado_sacrificio}{Elevado de sacrificio}
\item{doble_matanza}{Batazos para doble matanza (doble play)}
}}
\description{Estadísticas de bateadores}
\keyword{datasets}


library(tidyverse)
library(data.table)
setwd("E:/Dropbox/Documents/R/crime")

keepcrimes =
  c(''
    # , 'Serious Assault Resulting in Injury'
    # , 'Abduction and Kidnapping'
    # , 'Theft (Except Motor Vehicles), N.E.C.'
    # , 'Common Assault'
    # , 'Illegal Use of a Motor Vehicle'
    # , 'Aggravated Sexual Assault'
    # , 'Theft of Motor Vehicle Parts or Contents'
    # , 'Non-Aggravated Sexual Assault'
    # , 'Illegal Use of Property (Except Motor Vehicles)'
    # , 'Theft From Retail Premises'
    # , 'Theft of a Motor Vehicle'
    # , 'Serious Assault Not Resulting in Injury'
    # , 'Theft From a Person (Excluding By Force)'
    # , 'Blackmail and Extortion'
    # , 'Aggravated Robbery'
    # , 'Non-Aggravated Robbery'
    , 'Unlawful Entry With Intent/Burglary, Break and Enter'
  )

crime = fread("ANZSOC_data.csv",drop=c("Table 1",
                                       "Anzsoc Subdivision",
                                       "Anzsoc Division",
                                       "Locn Type Division",
                                       "Weapon"),
              stringsAsFactors = TRUE,
              check.names = TRUE) %>%
  filter(Territorial.Authority == "Auckland.",
         !grepl("9$",Area.Unit),
         Anzsoc.Group %in% keepcrimes) %>%
  select(-Territorial.Authority) %>%
  mutate(Year.Month = as.Date(paste(Year.Month,"01",sep=""),format="%Y%m%d"),
         Area.Unit = gsub("[.]$","",Area.Unit))

anzsoc = crime %>% group_by(Anzsoc.Group) %>%
  summarise(Records = sum(Number.of.Records))

crime2 = crime %>%
  group_by(Area.Unit,Meshblock, Anzsoc.Group) %>%
  summarise(Records = sum(Number.of.Records))

meshblocks = fread("meshblocks.csv",
                   stringsAsFactors = FALSE,
                   check.names = TRUE)

meshblocks$WKT = gsub(",.+$","",meshblocks$WKT)
meshblocks$WKT = gsub("^.+[(][(][(]","",meshblocks$WKT)
meshblocks$longitude = as.numeric(gsub(" .+$","",meshblocks$WKT))
meshblocks$latitude = as.numeric(gsub("^.+ ","",meshblocks$WKT))

meshblocks = meshblocks[,c(2,8,9)]

colnames(meshblocks)[1] = "Meshblock"

crime2 = crime2 %>%merge(meshblocks)

saveRDS(crime2, "crime.rds")


############################################################################
# Code to estimate regional scaling factors.
# Developed by Simon Hoyle, based on Adam Langley's original code & concept
# This version made available March 2021
# https://github.com/hoyles/regscale_cpue
############################################################################

library(mgcv)
library(here)
library(tidyverse)

repodir <- paste0(here(),"/")
projdir <- paste0(repodir,"..")

regscale_wkdir <- paste0(projdir,"/regscale_wkdir")
dir.create(regscale_wkdir)
setwd(regscale_wkdir)

source(paste0(repodir, "support_functions.r"))

windows(width=10, height = 10)
plot_IO(plot_title = "", uselims = c(20, 130, -50, 25), sp = "YFT2", newm=TRUE, lwdm=3, axes = T, tcol = 1, mapfill = TRUE, bgc = "lightgrey")
savePlot("map_YFT_regions", type = "png")
plot_IO(plot_title = "", uselims = c(20, 130, -50, 25), sp = "BET3", newm=TRUE, lwdm=3, axes = T, tcol = 1, mapfill = TRUE, bgc = "lightgrey")
savePlot("map_BET_regions", type = "png")

## Set up data
cefile <- "IOTC-2020-WPTT22-DATA04-CELongline.zip" # The IOTC 2020 data file. Data for the scaling period is unlikely to change.
lldat <- read.csv(unzip(cefile),stringsAsFactors=F)
lldat <- prepCE(lldat)  # Data preparation code in source_functions.r
lldat <- lldat[substring(lldat$Fleet,1,3) %in% c("JPN","KOR"),]
load(file=paste0(repodir,"cell_areas.RData"))

# Data checking
str(lldat)
table(substring(lldat$Grid,1,1), lldat$Fleet) # make sure it's getting data
table(lldat$regB3, useNA = "always")
table(lldat$regY2, useNA = "always")
table(lldat$lat5)
length(unique(lldat$latlong[lldat$regB3 > 0])) # grid cells per regional structure
length(unique(lldat$latlong[lldat$regY2 > 0]))

# figure showing number of 5 degree grid cells per region - BET
a <- aggregate(cbind(Effort, BET.NO, YFT.NO) ~ latlong + regB3 + Year, sum, data = lldat)
a <- a[a$regB3 != 0,]
a$regB3[a$regB3  ==  4] <- 3 # for plotting, merge region 4 (southeast) into region 3 (southwest)
table(a$regB3)
windows()
aB <- with(a, tapply(Effort, list(Year, regB3), length))
plot(as.numeric(rownames(aB)), aB[,1], type = "l", ylim = c(0, 70), xlim = c(1955, 2018),
     xlab = "Year", ylab = "Number of 5 degree grid cells", main = "BET")
for(r in 2:4) lines(as.numeric(rownames(aB)), aB[,r], col = r)
legend("topright", legend = c("Region 1N", "Region 1S", "Region 2", "Region 3"), lty = 1, col = c(4,1,2,3))
savePlot("Bigeye regB3 cells", type = "png")

# figure showing number of 5 degree grid cells per region - YFT
a <- aggregate(cbind(Effort, BET.NO, YFT.NO) ~ latlong + regY2 + Year, sum, data = lldat)
a <- a[a$regY2 != 0,]
aY <- with(a, tapply(Effort, list(Year, regY2), length))
windows()
plot(as.numeric(rownames(aY)), aY[,1], type = "l", ylim = c(0, 55), xlim = c(1955, 2018),
     xlab = "Year", ylab = "Number of 5 degree grid cells", main = "YFT")
for(r in 2:7) lines(as.numeric(rownames(aY)), aY[,r], col = r)
legend("topright", legend = c("Region 1", "Region 2N", "Region 2S", "Region 3", "Region 4",
                              "Region 5", "Region 6"), lty = 1, col = c(1,7,2:6))
savePlot("Yellowfin regY2 cells", type = "png")

# Figure showing number of 5 degree grid cells per region and qtr - YFT
names(lldat)
lldat$qtr <- lldat$yq - lldat$Year
a <- aggregate(cbind(Effort, BET.NO, YFT.NO) ~ latlong + regY2 + qtr + Year, sum, data = lldat)
a <- a[a$regY2 != 0,]
windows(14, 12); par(mfrow = c(2,3))
for(r in c(2,7,5,3,4)) {
  aa <- a[a$regY2 == r,]
  aY <- with(aa, tapply(Effort, list(Year, qtr), length))
  plot(as.numeric(rownames(aY)), aY[,1], type = "l", ylim = c(0, 45), xlim = c(1955, 2018),
       xlab = "Year", ylab = "Number of 5 degree grid cells", main = paste0("R", r))
  for(q in 2:4) lines(as.numeric(rownames(aY)), aY[,q], col = q)
  legend("topright", legend = c("Q 1", "Q 2", "Q 3", "Q 4"),lty = 1, col = c(1:4))
}
savePlot("Yellowfin cells by qtr and yr", type = "png")

# Figure showing number of 5 degree strata per region and qtr - YFT
a <- aggregate(cbind(Effort, BET.NO, YFT.NO) ~ latlong + regY2 + qtr + MonthStart + Year, sum, data = lldat)
a <- a[a$regY2 != 0,]
windows(14, 12); par(mfrow = c(2,3))
for(r in c(2,7,5,3,4)) {
  aa <- a[a$regY2 == r,]
  aY <- with(aa, tapply(Effort, list(Year, qtr), length))
  plot(as.numeric(rownames(aY)), aY[,1], type = "l", ylim = c(0, 90), xlim = c(1955, 2018),
       xlab = "Year", ylab = "Number of 5 degree grid cells", main = paste0("R", r))
  for(q in 2:4) lines(as.numeric(rownames(aY)), aY[,q], col = q)
  legend("topright", legend = c("Q 1", "Q 2", "Q 3", "Q 4"),lty = 1, col = c(1:4))
}
savePlot("Yellowfin strata by qtr and yr", type = "png")

# Scaling analysis starts here
pds <- data.frame(st=c(1960, 1963, 1975, 1979, 1980), nd=c(1975, 1975, 1994, 1994, 2000)) # choose options for scaling periods
pdnm <- as.character(c(6075, 6375, 7594, 7994, 8000)) # name the alternative scaling periods
allreg <- list(YFT=c(1,2,3,4,5,6,7), BET = c(1,2,3,4,5)) # regions to include

# select data
allwts <- list()
# sp="YFT"; pd = 4 # options for testing

for (pd in 1:5) {
  for (sp in c("YFT", "BET")) {
    ll <- lldat[lldat$yq > pds[pd,"st"] & lldat$yq < pds[pd,"nd"],]
    doreg <- with(allreg, get(sp)) # get the list of regions to run
    if (sp == "YFT") {
      ll$sp <- ll$YFT.NO
      spreg = "YFT2"
      spreg2 <- "regY2"
    }
    if (sp== "BET") {
      ll$sp <- ll$BET.NO
      spreg = "BET3"
      spreg2 <- "regB3"
    }
    ll$reg <- ll[,spreg2]
    ddd <- ll[ll$reg %in% doreg,]
    ddd$llxx <- as.factor(paste(ddd$reg, ddd$lat5, ddd$lon5, sep = "_"))
    # Remove where not enough effort
    a <- tapply(ddd$Effort, ddd$llxx, sum,na.rm = TRUE)
    a <- a[a > 50000]
    ddd <- ddd[is.na(match(ddd$llxx,names(a))) == F,]
    ##minimum number of strata
    a <- tapply(ddd$llxx, ddd$llxx, length)
    a <- a[a > 6]
    ddd <- ddd[is.na(match(ddd$llxx,names(a))) == F,]
    ##small number of zero catch records
    ddd$sp[is.na(ddd$sp)] <- 0
    table(ddd$sp > 0, useNA = "always")
    mn <- 0.1 * mean(ddd$sp / ddd$Effort)
    # Calulate statistical wts - by area. Weights are (cell area) / number of strata.
    wts <- mk_wts(dat = ddd, wttype = "cell_area", cell_areas = cell_areas)
    ddd <- ddd[!is.na(wts) & wts > 0,]
    wts <- wts[!is.na(wts) & wts > 0]
    wts <- wts / mean(wts, na.rm = TRUE)

    # Set up variables as factors
    ddd$yrqtr <- factor(ddd$yrqtr)
    ddd$llxx <- factor(ddd$llxx)
    ddd$fl <- factor(ddd$Fleet)
    ddd$yr <- as.factor(ddd$Year)
    ddd$qtr <- ddd$yq - ddd$Year
    ddd$reg_qtr <- factor(paste(ddd$reg, ddd$qtr, sep = "_"))

    # Standardization models that estimate the relative cell contributions to CPUE
    model23 <- glm(log(sp/Effort + mn) ~ yrqtr + llxx, data = ddd)
    model4 <- glm(log(sp/Effort + mn) ~ yrqtr + llxx, data = ddd, weights = wts) # add statistical weights
    if (length(unique(ddd$fl)) > 1) {
      model5 <- glm(log(sp/Effort + mn) ~ yrqtr + llxx + fl, data = ddd, weights = wts) # include fleet
      model6 <- glm(log(sp/Effort + mn) ~ yr + llxx + fl + reg_qtr, data = ddd, weights = wts) # include quarterly effects
      model7 <- gam(log(sp/Effort + mn) ~ yr + te(lat5, lon5) + fl + reg_qtr, data = ddd, weights = wts) # gam

    } else {
      model5 <- glm(log(sp/Effort + mn) ~ yrqtr + llxx, data = ddd, weights = wts) # include fleet
      model6 <- glm(log(sp/Effort + mn) ~ yr + llxx + reg_qtr, data = ddd, weights = wts) # include quarterly effects
      model7 <- gam(log(sp/Effort + mn) ~ yr + te(lat5, lon5) + reg_qtr, data = ddd, weights = wts) # gam
      }
    assign(paste0(sp,"_model23"), model23)
    assign(paste0(sp,"_model4"), model4)
    assign(paste0(sp,"_model5"), model5)
    assign(paste0(sp,"_model6"), model6)
    assign(paste0(sp,"_model7"), model7)

    # Predict
    newdat <- expand.grid(llxx = levels(ddd$llxx), yrqtr = levels(ddd$yrqtr))
    newdat$fl <- levels(ddd$fl)[1]
    newdat$cpue23 <- exp(predict.glm(model23, newdata = newdat, type = "response")) - mn
    newdat$cpue4 <- exp(predict.glm(model4, newdata = newdat, type = "response")) - mn
    newdat$cpue5 <- exp(predict.glm(model5, newdata = newdat, type = "response")) - mn
    newdat$cpue5 <- exp(predict.glm(model5, newdata = newdat, type = "response")) - mn
    a <- substring(as.character(newdat$llxx), 3)
    newdat$area <- cell_areas[match(a, cell_areas$latlong), "areax"]
    newdat$area[is.na(newdat$area)] <- 0
    newdat$reg <- substring(as.character(newdat$llxx), 1, 1)

    newdat6 <- expand.grid(llxx = levels(ddd$llxx), qtr = sort(unique(ddd$qtr)), yr = levels(ddd$yr), fl = levels(ddd$fl)[1])
    newdat6$reg <- substring(as.character(newdat6$llxx), 1, 1)
    newdat6$reg_qtr <- paste(newdat6$reg, newdat6$qtr, sep = "_")
    newdat6 <- newdat6[newdat6$reg_qtr %in% unique(ddd$reg_qtr),]  # remove reg_qtr values that can't be predicted because no data were in the model
    newdat6$cpue6 <- exp(predict.glm(model6, newdata = newdat6, type = "response")) - mn
    a <- substring(as.character(newdat6$llxx), 3)
    newdat6$area <- cell_areas[match(a, cell_areas$latlong), "areax"]

    # include all llxx, plus all lat*lon interactions where lat5 < 0 and lon5 > 40 & lon5 < 100
    newdat7 <- expand.grid(lat5 = sort(unique(ddd$lat5)), lon5 = sort(unique(ddd$lon5)), qtr = sort(unique(ddd$qtr)), yr = levels(ddd$yr), fl = levels(ddd$fl)[1])
    newdat7 <- setup_IO_regions(newdat7, regY2=TRUE, regB3 = TRUE)
    newdat7$reg <- newdat7[,spreg2]
    newdat7 <- newdat7[newdat7$reg %in% doreg,]
    newdat7$llxx <- paste(newdat7$reg, newdat7$lat5, newdat7$lon5, sep = "_")
    newdat7$reg_qtr <- paste(newdat7$reg, newdat7$qtr, sep = "_")
    newdat7 <- newdat7[newdat7$reg_qtr %in% sort(unique(ddd$reg_qtr)),]    # remove reg_qtr values that can't be predicted because no data were in the model
    newdat7$cpue7 <- exp(predict.gam(model7, newdata = newdat7, type = "response")) - mn
    a <- substring(as.character(newdat7$llxx), 3)
    newdat7$area <- cell_areas[match(a, cell_areas$latlong), "areax"]
    newdat7 <- newdat7[newdat7$llxx %in% newdat6$llxx | (newdat7$lat5 < 0 & newdat7$lon5 > 40 & newdat7$lon5 < 100),]

    a <- newdat7[!newdat7$llxx %in% newdat6$llxx,]
    colnames(a)[colnames(a)=="cpue7"] <- "cpue6"
    newdat8 <- rbind(newdat6, a[,colnames(newdat6)])
    colnames(newdat8)[colnames(newdat8)=="cpue6"] <- "cpue8"

    llmn23 <- tapply(newdat$cpue23, newdat$llxx, mean)*3000
    regx <- substring(names(llmn23),1,1)
    wts2 <- tapply(llmn23, regx, sum)
    wts2 <- wts2 / max(wts2)
    assign(x = paste0(sp, "_wts2_",pdnm[pd]), value = wts2)

    latlongx <- substring(names(llmn23), 3)
    areax <- cell_areas[match(latlongx, cell_areas$latlong), "areax"]
    areax[is.na(areax)] <- 0
    wts3 <- tapply(llmn23 * areax, regx, sum)
    wts3 <- wts3 / max(wts3)
    assign(x = paste0(sp, "_wts3_",pdnm[pd]), value = wts3)

    llmn4 <- tapply(newdat$cpue4, newdat$llxx, mean)*3000
    regx <- substring(names(llmn4),1,1)
    wts4 <- tapply(llmn4 * areax, regx, sum)
    wts4 <- wts4 / max(wts4)
    assign(x = paste0(sp, "_wts4_",pdnm[pd]), value = wts4)

    llmn5 <- tapply(newdat$cpue5, newdat$llxx, mean)*3000
    regx <- substring(names(llmn5),1,1)
    wts5 <- tapply(llmn5 * areax, regx, sum)
    wts5 <- wts5 / max(wts5)
    assign(x = paste0(sp, "_wts5_",pdnm[pd]), value = wts5)

    llmn6 <- tapply(newdat6$cpue6, newdat6$llxx, mean)*3000
    regx6 <- substring(names(llmn6),1,1)
    latlongx6 <- substring(names(llmn6), 3)
    areax6 <- cell_areas[match(latlongx6, cell_areas$latlong), "areax"]
    areax6[is.na(areax6)] <- 0
    wts6 <- tapply(llmn6 * areax6, regx6, sum)
    wts6 <- wts6 / max(wts6)
    assign(x = paste0(sp, "_wts6_",pdnm[pd]), value = wts6)

    llmn7 <- tapply(newdat7$cpue7, newdat7$llxx, mean)*3000
    regx7 <- substring(names(llmn7),1,1)
    latlongx7 <- substring(names(llmn7), 3)
    areax7 <- cell_areas[match(latlongx7, cell_areas$latlong), "areax"]
    areax7[is.na(areax7)] <- 0
    wts7 <- tapply(llmn7 * areax7, regx7, sum)
    wts7 <- wts7 / max(wts7)
    assign(x = paste0(sp, "_wts7_",pdnm[pd]), value = wts7)

    llmn8 <- tapply(newdat8$cpue8, newdat8$llxx, mean)*3000
    regx8 <- substring(names(llmn8),1,1)
    latlongx8 <- substring(names(llmn8), 3)
    areax8 <- cell_areas[match(latlongx8, cell_areas$latlong), "areax"]
    areax8[is.na(areax8)] <- 0
    wts8 <- tapply(llmn8 * areax8, regx8, sum)
    wts8 <- wts8 / max(wts8)
    assign(x = paste0(sp, "_wts8_",pdnm[pd]), value = wts8)

    mcalc1 <- tapply(ddd$sp/ddd$Effort, ddd$llxx, mean)*3000
    regx <- substring(names(mcalc1),1,1)
    mwts <- tapply(mcalc1, regx, sum)
    mwts <- mwts / max(mwts)
    assign(x = paste0(sp, "_wts_mean_",pdnm[pd]), value = mwts/max(mwts))

    plot_patterns(mcalc1, sp, spreg)
    savePlot(paste0("relative wt_means_",pdnm[pd],sp),type = "png")
    plot_patterns(llmn23, sp, spreg)
    savePlot(paste0("relative wt23_",pdnm[pd],sp),type = "png")
    plot_patterns(llmn4, sp, spreg)
    savePlot(paste0("relative wt4_",pdnm[pd],sp),type = "png")
    plot_patterns(llmn5, sp, spreg)
    savePlot(paste0("relative wt5_",pdnm[pd],sp),type = "png")
    plot_patterns(llmn6, sp, spreg)
    savePlot(paste0("relative wt6_",pdnm[pd],sp),type = "png")
    plot_patterns(llmn7, sp, spreg)
    savePlot(paste0("relative wt7_",pdnm[pd],sp),type = "png")
    plot_patterns(llmn8, sp, spreg)
    savePlot(paste0("relative wt8_",pdnm[pd],sp),type = "png")
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts1")]] <- mwts/max(mwts)
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts2")]] <- wts2
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts3")]] <- wts3
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts4")]] <- wts4
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts5")]] <- wts5
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts6")]] <- wts6
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts7")]] <- wts7
    allwts[[paste0(spreg,"_", pdnm[pd],"_wts8")]] <- wts8

    windows(height= 10, width = 8); par(mfrow = c(2,1), oma = c(0,0,2,0), mar = c(5,3,1,2)+.1)
    a <- with(model6, tapply(residuals, list(data$yq, data$reg), mean))
    yq <- as.numeric(rownames(a))
    plot(yq, yq, type = "n", xlab = "Year-quarter", ylim = c(-1.5,1.8))
    regseq <- sort(unique(ddd$reg))
    for(r in 1:length(regseq)) {
      lines(yq, a[,r], col = r)
    }
    legend("top", legend = regseq, lty = 1, col = 1:length(regseq), horiz = TRUE)
    boxplot(model6$residuals ~ model6$data$Year, xlab = "Year")
    title(main = paste(sp, " ", pds[pd,"st"],"-", pds[pd,"nd"]), outer = "TRUE")
    savePlot(paste0("resids_by_reg_",pdnm[pd],sp),type = "png")

    windows(height=15,width=8); par(mfrow=c(4,2), mar = c(4,4,3,1))
    plotdiags(model23$residuals, ti = paste(sp,"m2"))
    plotdiags(model4$residuals, ti = paste(sp,"m4"))
    plotdiags(model5$residuals, ti = paste(sp,"m5"))
    plotdiags(model6$residuals, ti = paste(sp,"m6"))
    savePlot(paste0("resid_dbns_",pdnm[pd],sp),type = "png")

    drop6 <- drop1(model6, test = "LRT")
    write.csv(drop6, paste0(sp,"drop6",pdnm[pd],sp,".csv"))
    drop5 <- drop1(model5)
    write.csv(drop5, paste0(sp,"drop5",pdnm[pd],sp,".csv"))

    graphics.off()
  }
  # save(BET_wts, BET_wts_mean, file = paste0("BET_wts_",pdnm[pd],".RData"))
  # save(YFT_wts, YFT_wts_mean, file = paste0("YFT_wts_",pdnm[pd],".RData"))
}
save(allwts, file = paste0("allwts.RData"))
load(file = "allwts.RData")

# check the results
cbind(areax, regx)
barplot(tapply(areax, regx, mean)) # average sizes of the cells in each region
barplot(tapply(llmn23, regx, mean))
barplot(rbind(mwts,wts2,wts3,wts4,wts5,wts6), beside = T)

# Save the results
posy <- grep("YFT2",names(allwts))
posb <- grep("BET3",names(allwts))
allwtsy <- t(as.matrix(data.frame(allwts[posy])))
allwtsb <- t(as.matrix(data.frame(allwts[posb])))
write.csv(allwtsy, "allwt_yft.csv")
write.csv(allwtsb, "allwt_bet.csv")

a5 <- rbind(cbind(tp=5, sp="BET", read.csv(paste0("BETdrop57994BET.csv"))),
            cbind(tp=5, sp="YFT", read.csv(paste0("YFTdrop57994YFT.csv"))),
            cbind(tp=6, sp="BET", read.csv(paste0("BETdrop67994BET.csv"))[,1:4]),
            cbind(tp=6, sp="YFT", read.csv(paste0("YFTdrop67994YFT.csv"))[,1:4]))
a <- a5 %>% group_by(sp, tp) %>%
      mutate(deltaAIC = AIC - min(AIC))
write.csv(a, file = "table1.csv")

# predict relative catch rates for the same kind of effort for all quarters in 1990-2000
# average the prediction across vessels. Choose an HBF or average across. Choose a time period. Sum across areas.
str(lldat)
table(lldat$regB3)
reglist <- data.frame(index=1:5,regnumY=1:5, regnumB=c(1:5), regY2=c("2S",3,4,5,"2N"),regB3=c("1S",2,3,4,"1N"))

# Plots to compare the various time periods and models, by species
legtxt.pd <- c("1960-1975","1963-1975","1975-1994","1979-1994","1980-2000")
windows()
sp="YFT"
for (mdi in 1:8) {
  for(spr in c("YFT2")) {
    nmx <- paste0(paste(spr, pdnm, "wts", sep = "_"), mdi)
    a <- data.frame()
    for(i in 1:5) a <- rbind(a, with(allwts, get(nmx[i])))
    colnames(a) <- 1:7
    a <- a[,c(1,7,2,3,4,5,6)]
    colnames(a) <- paste0("R", c(1,"2N", "2S", 3,4,5,6))
    barplot(as.matrix(a), beside=TRUE, names.arg = colnames(a), legend = legtxt.pd, args.legend = list(x="topleft", adj = c(0,0.1)), main = paste("Model", mdi))
    savePlot(paste("barplot", sp, "wts_md", mdi, sep = "_"), type = "png")
  }
}

legtxt.pd <- c("1960-1975","1963-1975","1975-1994","1979-1994","1980-2000")
windows()
sp="BET"
for (mdi in 1:8) {
  for(spr in c("BET3")) {
    nmx <- paste0(paste(spr, pdnm, "wts", sep = "_"), mdi)
    a <- data.frame()
    for(i in 1:5) a <- rbind(a, with(allwts, get(nmx[i])))
    colnames(a) <- 1:5
    a <- a[,c(5,1,2,3,4)]
    sth <- apply(a[,4:5],1,sum)
    a <- cbind(a[,1:3], sth)
    a <- a / apply(a,1,max)
    colnames(a) <- paste0("R", c("1N", "1S", 2,3))
    barplot(as.matrix(a), beside=TRUE, names.arg = colnames(a), legend = legtxt.pd, args.legend = list(x="topleft", adj = c(0,0.1)), main = paste("Model", mdi))
    savePlot(paste("barplot", sp, "wts_md", mdi, sep = "_"), type = "png")
  }
}

legtxt <- c("m1 means","m2 stdized","m3 areas","m4 stat m","m5 fleet","m6 qtr","m7 gam", "m8 merged")

windows()
sp="YFT"
for (pd in 1:5) {
  pdx <- pdnm[pd]
  for(spr in c("YFT2")) {
    nmx <- paste0(paste(spr, pdx, "wts", sep = "_"), 1:8)
    a <- data.frame()
    for(i in 1:8) a <- rbind(a, with(allwts, get(nmx[i])))
    colnames(a) <- 1:7
    a <- a[,c(1,7,2,3,4,5,6)]
    colnames(a) <- paste0("R", c(1,"2N", "2S", 3,4,5,6))
    barplot(as.matrix(a), beside=TRUE, names.arg = colnames(a), legend = legtxt, args.legend = list(x="topleft", y.intersp=0.8, adj=c(0,0.1)), main = paste(pds[pd, "st"], "-", pds[pd, "nd"]))
    savePlot(paste("barplot", sp, "wts", pdx, sep = "_"), type = "png")
  }
}

windows()
sp="BET"
for (pd in 1:5) {
  pdx <- pdnm[pd]
  for(spr in c("BET3")) {
    nmx <- paste0(paste(spr, pdx, "wts", sep = "_"), 1:8)
    a <- data.frame()
    for(i in 1:8) a <- rbind(a, with(allwts, get(nmx[i])))
    colnames(a) <- 1:5
    a <- a[,c(5,1,2,3,4)]
    sth <- apply(a[,4:5],1,sum)
    a <- cbind(a[,1:3], sth)
    a <- a / apply(a,1,max)
    colnames(a) <- paste0("R", c("1N", "1S", 2,3))
    barplot(as.matrix(a), beside=TRUE, names.arg = colnames(a), legend = legtxt, args.legend = list(x="topleft", y.intersp=0.8, adj=c(0,0.1)), main = paste(pds[pd, "st"], "-", pds[pd, "nd"]))
    savePlot(paste("barplot", sp, "wts", pdx, sep = "_"), type = "png")
  }
}

# Use the code below to prepare rescaled indices
# The functions ending in y work with annual indices, otherwise yq indices

# combines 2 indices
dowts <- function(d1, d2, wts, yq) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yq %in% yq], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yq %in% yq], na.rm = TRUE)
  dd <- data.frame(yq=d1$yq,pr=d1$pr * wts[1] + d2$pr[match(d1$yq,d2$yq)] * wts[2])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yq,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yq,d2$pr,col=2)
  lines(dd$yq,dd$pr,col=3)
  return(dd)
}

# combines 3 indices
dowts_3 <- function(d1, d2, d3, wts, yq) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yq %in% yq], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yq %in% yq], na.rm = TRUE)
  d3$pr <- d3$pr / mean(d3$pr[d3$yq %in% yq], na.rm = TRUE)
  dd <- data.frame(yq=d1$yq,pr=d1$pr * wts[1] + d2$pr[match(d1$yq,d2$yq)] * wts[2] + d3$pr[match(d1$yq,d3$yq)] * wts[3])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yq,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yq,d2$pr,col=2)
  lines(d3$yq,d3$pr,col=3)
  lines(dd$yq,dd$pr,col=4)
  return(dd)
}

dowts_3y <- function(d1, d2, d3, wts, yrs) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yr %in% yrs], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yr %in% yrs], na.rm = TRUE)
  d3$pr <- d3$pr / mean(d3$pr[d3$yr %in% yrs], na.rm = TRUE)
  dd <- data.frame(yr=d1$yr,pr=d1$pr * wts[1] + d2$pr[match(d1$yr,d2$yr)] * wts[2] + d3$pr[match(d1$yr,d3$yr)] * wts[3])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yr,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yr,d2$pr,col=2)
  lines(d3$yr,d3$pr,col=3)
  lines(dd$yr,dd$pr,col=4)
  return(dd)
}

# combines 4 indices
dowts_4 <- function(d1, d2, d3, d4, wts, yq) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yq %in% yq], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yq %in% yq], na.rm = TRUE)
  d3$pr <- d3$pr / mean(d3$pr[d3$yq %in% yq], na.rm = TRUE)
  d4$pr <- d4$pr / mean(d4$pr[d4$yq %in% yq], na.rm = TRUE)
  dd <- data.frame(yq=d1$yq,pr=d1$pr * wts[1] + d2$pr[match(d1$yq,d2$yq)] * wts[2] + d3$pr[match(d1$yq,d3$yq)] * wts[3] + d4$pr[match(d1$yq,d4$yq)] * wts[4])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yq,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yq,d2$pr,col=2)
  lines(d3$yq,d3$pr,col=3)
  lines(d4$yq,d4$pr,col=3)
  lines(dd$yq,dd$pr,col=4)
  return(dd)
}

dowts_4y <- function(d1, d2, d3, d4, wts, yrs) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yr %in% yrs], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yr %in% yrs], na.rm = TRUE)
  d3$pr <- d3$pr / mean(d3$pr[d3$yr %in% yrs], na.rm = TRUE)
  d4$pr <- d4$pr / mean(d4$pr[d4$yr %in% yrs], na.rm = TRUE)
  dd <- data.frame(yr=d1$yr,pr=d1$pr * wts[1] + d2$pr[match(d1$yr,d2$yr)] * wts[2] + d3$pr[match(d1$yr,d3$yr)] * wts[3] + d4$pr[match(d1$yr,d4$yr)] * wts[4])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yr,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yr,d2$pr,col=2)
  lines(d3$yr,d3$pr,col=3)
  lines(d4$yr,d4$pr,col=3)
  lines(dd$yr,dd$pr,col=4)
  return(dd)
}

# combines 5 indices
dowts_5 <- function(d1, d2, d3, d4, d5, wts, yq) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yq %in% yq], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yq %in% yq], na.rm = TRUE)
  d3$pr <- d3$pr / mean(d3$pr[d3$yq %in% yq], na.rm = TRUE)
  d4$pr <- d4$pr / mean(d4$pr[d4$yq %in% yq], na.rm = TRUE)
  d5$pr <- d5$pr / mean(d5$pr[d5$yq %in% yq], na.rm = TRUE)
  dd <- data.frame(yq=d1$yq,pr=d1$pr * wts[1] + d2$pr[match(d1$yq,d2$yq)] * wts[2] + d3$pr[match(d1$yq,d3$yq)] * wts[3] + d4$pr[match(d1$yq,d4$yq)] * wts[4] + d5$pr[match(d1$yq,d5$yq)] * wts[5])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yq,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yq,d2$pr,col=2)
  lines(d3$yq,d3$pr,col=3)
  lines(d4$yq,d4$pr,col=4)
  lines(d5$yq,d5$pr,col=5)
  lines(dd$yq,dd$pr,col=6, lwd = 2)
  return(dd)
}

dowts_5y <- function(d1, d2, d3, d4, d5, wts, yrs) {
  d1$pr <- d1$pr / mean(d1$pr[d1$yr %in% yrs], na.rm = TRUE)
  d2$pr <- d2$pr / mean(d2$pr[d2$yr %in% yrs], na.rm = TRUE)
  d3$pr <- d3$pr / mean(d3$pr[d3$yr %in% yrs], na.rm = TRUE)
  d4$pr <- d4$pr / mean(d4$pr[d4$yr %in% yrs], na.rm = TRUE)
  d5$pr <- d5$pr / mean(d5$pr[d5$yr %in% yrs], na.rm = TRUE)
  dd <- data.frame(yr=d1$yr,pr=d1$pr * wts[1] + d2$pr[match(d1$yr,d2$yr)] * wts[2] + d3$pr[match(d1$yr,d3$yr)] * wts[3] + d4$pr[match(d1$yr,d4$yr)] * wts[4] + d5$pr[match(d1$yr,d5$yr)] * wts[5])
  dd$pr <- dd$pr/mean(dd$pr,na.rm=TRUE)
  plot(d1$yr,d1$pr,type="l",col=1, xlab = "Year-quarter", ylab = "Relative CPUE")
  lines(d2$yr,d2$pr,col=2)
  lines(d3$yr,d3$pr,col=3)
  lines(d4$yr,d4$pr,col=4)
  lines(d5$yr,d5$pr,col=5)
  lines(dd$yr,dd$pr,col=6, lwd = 2)
  return(dd)
}

#
# Load bigeye indices 2017
yq <- seq(1980.125, 1999.875, .25)
yq6075 <- seq(1963.125, 1975.875, .25)
bet1 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_boat_allyrs.csv"))
bet2 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_boat_allyrs.csv"))
bet1n <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_boat_allyrs.csv"))
bet1s <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_boat_allyrs.csv"))
betnovess1 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_novess_allyrs.csv"))
betnovess1n <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_novess_allyrs.csv"))
betnovess1s <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_novess_allyrs.csv"))
betnovess2 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_novess_allyrs.csv"))
bet5279_1 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_novess_5279.csv"))
bet5279_1n <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_novess_5279.csv"))
bet5279_1s <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_novess_5279.csv"))
bet5279_2 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_novess_5279.csv"))
bet79nd_1 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_vessid_79nd.csv"))
bet79nd_1n <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_vessid_79nd.csv"))
bet79nd_1s <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_vessid_79nd.csv"))
bet79nd_2 <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_vessid_79nd.csv"))

# get scaling factors, combine indices, and save the results
wts2 <- allwts$BET3_8000_wts6[c(5,1,2) + 1]
wts2_early <- allwts$BET3_6375_wts6[c(5,1,2) + 1]
windows(12,12); par(mfrow = c(2,2))
dd <- dowts_3(bet1n, bet1s, bet2, wts2, yq)
write.csv(dd,"Joint_regB3_R12_dellog_boat_allyrs.csv")
dd <- dowts_3(betnovess1n, betnovess1s, betnovess2, wts2, yq)
write.csv(dd,"Joint_regB3_R12_dellog_novess_allyrs.csv")
dd <- dowts_3(bet5279_1n, bet5279_1s, bet5279_2, wts2_early, yq = yq6075)
write.csv(dd,"Joint_regB3_R12_dellog_novess_5279.csv")
dd <- dowts_3(bet79nd_1n, bet79nd_1s, bet79nd_2, wts2, yq)
write.csv(dd,"Joint_regB3_R12_dellog_vessid_79nd.csv")
savePlot("Joint_regB3_R12_dellog", type = "png")

# Annual bigeye indices 2017
yrs <- seq(1980, 1999, 1)
yrs6375 <- seq(1963, 1975, 1)
bet1y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_boat_allyrsyr.csv"))
bet2y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_boat_allyrsyr.csv"))
bet1ny <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_boat_allyrsyr.csv"))
bet1sy <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_boat_allyrsyr.csv"))
betnovess1y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_novess_allyrsyr.csv"))
betnovess1ny <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_novess_allyrsyr.csv"))
betnovess1sy <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_novess_allyrsyr.csv"))
betnovess2y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_novess_allyrsyr.csv"))
bet5279_1y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_novess_5279yr.csv"))
bet5279_1ny <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_novess_5279yr.csv"))
bet5279_1sy <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_novess_5279yr.csv"))
bet5279_2y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_novess_5279yr.csv"))
bet79nd_1y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R1_dellog_vessid_79ndyr.csv"))
bet79nd_1ny <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R5_dellog_vessid_79ndyr.csv"))
bet79nd_1sy <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf_spl/outputs/Joint_regB3_R1_dellog_vessid_79ndyr.csv"))
bet79nd_2y <- read.csv(paste0(jntalysis_dir17,"std_nocl_hbf/outputs/Joint_regB2_R2_dellog_vessid_79ndyr.csv"))
wts6 <- allwts$BET3_8000_wts6[c(5,1,2) + 1]
wts6_early <- allwts$BET3_6375_wts6[c(5,1,2) + 1]
windows(12,12); par(mfrow = c(2,2))
dd <- dowts_3y(bet1ny, bet1sy, bet2y, wts6, yrs)
write.csv(dd,"Joint_regB3_R12_dellog_boat_allyrsyr.csv")
dd <- dowts_3y(betnovess1ny, betnovess1sy, betnovess2y, wts6, yrs)
write.csv(dd,"Joint_regB3_R12_dellog_novess_allyrsyr.csv")
dd <- dowts_3y(bet5279_1ny, bet5279_1sy, bet5279_2y, wts6_early, yrs = yrs6375)
write.csv(dd,"Joint_regB3_R12_dellog_novess_5279yr.csv")
dd <- dowts_3y(bet79nd_1ny, bet79nd_1sy, bet79nd_2y, wts6, yrs)
write.csv(dd,"Joint_regB3_R12_dellog_vessid_79ndyr.csv")
savePlot("Joint_regB3_R12_dellogy", type = "png")

# Quarterly yellowfin indices 2018
yq <- seq(1979.125, 1993.875, .25)
yq6075 <- seq(1963.125, 1974.875, .25)
yft5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_boat_allyrs_yq.csv"))
yft2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_boat_allyrs_yq.csv"))
yft3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_boat_allyrs_yq.csv"))
yft4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_boat_allyrs_yq.csv"))
yft2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_boat_allyrs_yq.csv"))
yft2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_boat_allyrs_yq.csv"))
yftnovess5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_novess_allyrs_yq.csv"))
yftnovess2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_novess_allyrs_yq.csv"))
yftnovess2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_novess_allyrs_yq.csv"))
yftnovess2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_novess_allyrs_yq.csv"))
yftnovess3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_novess_allyrs_yq.csv"))
yftnovess4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_novess_allyrs_yq.csv"))
yft5279_5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_novess_5279_yq.csv"))
yft5279_2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_novess_5279_yq.csv"))
yft5279_2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_novess_5279_yq.csv"))
yft5279_2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_novess_5279_yq.csv"))
yft5279_3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_novess_5279_yq.csv"))
yft5279_4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_novess_5279_yq.csv"))
yft79nd_5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_vessid_79nd_yq.csv"))
yft79nd_2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_vessid_79nd_yq.csv"))
yft79nd_2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_vessid_79nd_yq.csv"))
yft79nd_2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_vessid_79nd_yq.csv"))
yft79nd_3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_vessid_79nd_yq.csv"))
yft79nd_4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_vessid_79nd_yq.csv"))
wts8 <- allwts$YFT2_7594_wts8[c(7,2,3,4,5)]
wts8_early <- allwts$YFT2_6375_wts8[c(7,2,3,4,5)]
windows(12,12); par(mfrow = c(2,2))
dd <- dowts_5(yft2n, yft2s, yft3, yft4, yft5, wts8, yq)
write.csv(dd,"Joint_regY2_R2345_dellog_boat_allyrs_yq.csv")
dd <- dowts_5(yftnovess2n, yftnovess2s, yftnovess3, yftnovess4, yftnovess5, wts8, yq)
write.csv(dd,"Joint_regY2_R2345_dellog_novess_allyrs_yq.csv")
dd <- dowts_5(yft5279_2n, yft5279_2s, yft5279_3, yft5279_4, yft5279_5, wts8_early, yq = yq6075)
write.csv(dd,"Joint_regY2_R2345_dellog_novess_5279_yq.csv")
dd <- dowts_5(yft79nd_2n, yft79nd_2s, yft79nd_3, yft79nd_4, yft79nd_5, wts8, yq)
write.csv(dd,"Joint_regY2_R2345_dellog_vessid_79nd_yq.csv")
savePlot("Joint_regY2_R2345_dellog", type = "png")

# Annual yellowfin indices 2018
yrs <- seq(1975, 1993, 1)
yrs6375 <- seq(1963, 1974, 1)
yft5y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_boat_allyrs_yr.csv"))
yft2y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_boat_allyrs_yr.csv"))
yft3y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_boat_allyrs_yr.csv"))
yft4y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_boat_allyrs_yr.csv"))
yft2ny <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_boat_allyrs_yr.csv"))
yft2sy <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_boat_allyrs_yr.csv"))
yftnovess5y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_novess_allyrs_yr.csv"))
yftnovess2y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_novess_allyrs_yr.csv"))
yftnovess2ny <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_novess_allyrs_yr.csv"))
yftnovess2sy <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_novess_allyrs_yr.csv"))
yftnovess3y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_novess_allyrs_yr.csv"))
yftnovess4y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_novess_allyrs_yr.csv"))
yft5279_5y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_novess_5279_yr.csv"))
yft5279_2y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_novess_5279_yr.csv"))
yft5279_2ny <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_novess_5279_yr.csv"))
yft5279_2sy <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_novess_5279_yr.csv"))
yft5279_3y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_novess_5279_yr.csv"))
yft5279_4y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_novess_5279_yr.csv"))
yft79nd_5y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_vessid_79nd_yr.csv"))
yft79nd_2y <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_vessid_79nd_yr.csv"))
yft79nd_2ny <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_vessid_79nd_yr.csv"))
yft79nd_2sy <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_vessid_79nd_yr.csv"))
yft79nd_3y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_vessid_79nd_yr.csv"))
yft79nd_4y <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_vessid_79nd_yr.csv"))
wts8 <- allwts$YFT2_7594_wts8[c(7,2,3,4,5)]
wts8_early <- allwts$YFT2_6375_wts8[c(7,2,3,4,5)]
windows(12,12); par(mfrow = c(2,2))
dd <- dowts_5y(yft2ny, yft2sy, yft3y, yft4y, yft5y, wts8, yrs)
write.csv(dd,"Joint_regY2_R2345_dellog_boat_allyrs_yr.csv")
dd <- dowts_5y(yftnovess2ny, yftnovess2sy, yftnovess3y, yftnovess4y, yftnovess5y, wts8, yrs)
write.csv(dd,"Joint_regY2_R2345_dellog_novess_allyrs_yr.csv")
dd <- dowts_5y(yft5279_2ny, yft5279_2sy, yft5279_3y, yft5279_4y, yft5279_5y, wts8_early, yrs = yrs6375)
write.csv(dd,"Joint_regY2_R2345_dellog_novess_5279_yr.csv")
dd <- dowts_5y(yft79nd_2ny, yft79nd_2sy, yft79nd_3y, yft79nd_4y, yft79nd_5y, wts8, yrs)
write.csv(dd,"Joint_regY2_R2345_dellog_vessid_79nd_yr.csv")
savePlot("Joint_regY2_R2345_dellogyr", type = "png")

##############
# Combine indices - an alternative approach for YFT
yq6375 <- seq(1963.125, 1974.875, .25)
yq6075 <- seq(1960.125, 1974.875, .25)
yq7594 <- seq(1975.125, 1993.875, .25)
yq7994 <- seq(1979.125, 1993.875, .25)
yq8000 <- seq(1980.125, 1999.875, .25)
yr6075 <- 1960:1974
yr6375 <- 1963:1974
yr7594 <- 1975:1993
yr7994 <- 1979:1993
yr8000 <- 1980:1999

yft5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_boat_allyrs_yq.csv"))
yft2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_boat_allyrs_yq.csv"))
yft3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_boat_allyrs_yq.csv"))
yft4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_boat_allyrs_yq.csv"))
yft2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_boat_allyrs_yq.csv"))
yft2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_boat_allyrs_yq.csv"))
yftnovess5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_novess_allyrs_yq.csv"))
yftnovess2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_novess_allyrs_yq.csv"))
yftnovess2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_novess_allyrs_yq.csv"))
yftnovess2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_novess_allyrs_yq.csv"))
yftnovess3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_novess_allyrs_yq.csv"))
yftnovess4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_novess_allyrs_yq.csv"))
yft5279_5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_novess_5279_yq.csv"))
yft5279_2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_novess_5279_yq.csv"))
yft5279_2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_novess_5279_yq.csv"))
yft5279_2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_novess_5279_yq.csv"))
yft5279_3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_novess_5279_yq.csv"))
yft5279_4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_novess_5279_yq.csv"))
yft79nd_5 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R5_dellog_vessid_79nd_yq.csv"))
yft79nd_2 <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY_R2_dellog_vessid_79nd_yq.csv"))
yft79nd_2n <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R7_dellog_vessid_79nd_yq.csv"))
yft79nd_2s <- read.csv(paste0(jntalysis_dir,"cl0_hb1_hk1/outputs/Joint_regY2_R2_dellog_vessid_79nd_yq.csv"))
yft79nd_3 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R3_dellog_vessid_79nd_yq.csv"))
yft79nd_4 <- read.csv(paste0(jntalysis_dir,"cl1_hb0_hk1/outputs/Joint_regY_R4_dellog_vessid_79nd_yq.csv"))

yftlist <- list(yft2n, yft2s, yft3, yft4, yft5)
yftlist_ord <- c(7,2,3,4,5)
length(yftlist)

dowts_list <- function(dlist, wts, yq) { # Note that the regions in dlist & wts must be in the same sequence
  for(i in 1:length(dlist)) {
    a <- dlist[[i]]
    a$prwt <- wts[i] * a$pr / mean(a$pr[a$yq %in% yq], na.rm = TRUE)
    dlist[[i]] <- a
  }
  return(dlist)
}
load(file = "allwts.RData")

# Calulate means for each species and period
rng_mn <- function(x,y) mean(x$pr[x$yq %in% y], na.rm = TRUE)

yrng6075 <- c(rng_mn(yft2n, yq6075),rng_mn(yft2s, yq6075),rng_mn(yft3, yq6075),rng_mn(yft4, yq6075),rng_mn(yft5, yq6075))
yrng6375 <- c(rng_mn(yft2n, yq6375),rng_mn(yft2s, yq6375),rng_mn(yft3, yq6375),rng_mn(yft4, yq6375),rng_mn(yft5, yq6375))
yrng7594 <- c(rng_mn(yft2n, yq7594),rng_mn(yft2s, yq7594),rng_mn(yft3, yq7594),rng_mn(yft4, yq7594),rng_mn(yft5, yq7594))
yrng7994 <- c(rng_mn(yft2n, yq7994),rng_mn(yft2s, yq7994),rng_mn(yft3, yq7994),rng_mn(yft4, yq7994),rng_mn(yft5, yq7994))
yrng8000 <- c(rng_mn(yft2n, yq8000),rng_mn(yft2s, yq8000),rng_mn(yft3, yq8000),rng_mn(yft4, yq8000),rng_mn(yft5, yq8000))

yft6375st <- dowts_list(dlist = yftlist, wts = allwts$YFT2_6375_wts8[yftlist_ord], yq = yq6075)
yft6075st <- dowts_list(dlist = yftlist, wts = allwts$YFT2_6075_wts8[yftlist_ord], yq = yq6075)
yft7594st <- dowts_list(dlist = yftlist, wts = allwts$YFT2_7594_wts8[yftlist_ord], yq = yq7594)
yft7994st <- dowts_list(dlist = yftlist, wts = allwts$YFT2_7994_wts8[yftlist_ord], yq = yq7994)
yft8000st <- dowts_list(dlist = yftlist, wts = allwts$YFT2_8000_wts8[yftlist_ord], yq = yq8000)

# Barplots comparing each wt between periods
mkwt <- function(wtobj, wtnum) paste0(wtobj, "_wts", wtnum)

for (wt in 1:6) {
  a<- with(allwts, rbind(get(mkwt("YFT2_6075", wt)),get(mkwt("YFT2_6375", wt)),get(mkwt("YFT2_7594", wt)),get(mkwt("YFT2_7994", wt)),get(mkwt("YFT2_8000", wt))))
  a <- a[, yftlist_ord]
  a[1,] <- a[1,] / yrng6075
  a[2,] <- a[2,] / yrng6375
  a[3,] <- a[3,] / yrng7594
  a[4,] <- a[4,] / yrng7994
  a[5,] <- a[5,] / yrng8000
  a <- a / apply(a,1,max)
  colnames(a) <- paste0("R", c("2N", "2S", 3,4,5))
  windows()
  barplot(a, beside = TRUE, names.arg = colnames(a), legend = c("1960-1975","1963-1975","1975-1994","1979-1994","1980-2000"), args.legend = list(x = "topleft"), main = paste0("YFT m", wt))
  savePlot(paste0("barplot_YFTadj_pds_wts", wt), type = "png")

  a<- with(allwts, rbind(get(mkwt("BET3_6075", wt)),get(mkwt("BET3_6375", wt)),get(mkwt("BET3_8000", wt))))
  a <- a[,betlist_ord]
  sth <- apply(a[,4:5],1,sum)
  a <- cbind(a[,1:3], sth)
  a[1,] <- a[1,] / brng6075
  a[2,] <- a[2,] / brng6375
  a[3,] <- a[3,] / brng8000
  a <- a / apply(a,1,max)
  colnames(a) <- paste0("R", c("1N", "1S", 2,3))
  windows()
  barplot(a, beside = TRUE, names.arg = colnames(a), legend = c("1960-1975","1963-1975","1975-1994","1979-1994","1980-2000"), args.legend = list(x = "topleft"), main = paste0("BET m", wt))
  savePlot(paste0("barplot_BETadj_pds_wts", wt), type = "png")
}

windows(12,10); par(mfrow = c(3,2))
for(i in 1:5) {
  with(bet8000st[[i]], plot(yq, prwt, xlab = "Year-quarter", ylab = "Weighted CPUE", col= 1, type = "l", main = betlab[i]))
  with(bet6375st[[i]], lines(yq, prwt, col = 2, lty = 2))
}

dd <- dowts(bet1, bet2, BET_wts[-1], yq)
write.csv(dd,"Joint_regB2_R12_dellog_boat_allyrs.csv")
dd <- dowts(betnovess1, betnovess2, BET_wts[-1], yq)
write.csv(dd,"Joint_regB2_R12_dellog_novess_allyrs.csv")
dd <- dowts(bet5279_1, bet5279_2, BET_wts[-1], yq = yqfake)
write.csv(dd,"Joint_regB2_R12_dellog_novess_5279.csv")
dd <- dowts(bet79nd_1, bet79nd_2, BET_wts[-1], yq)
write.csv(dd,"Joint_regB2_R12_dellog_vessid_79nd.csv")
savePlot("Joint_regB2_R12_dellog", type = "png")

windows()
a <- with(allwts, rbind(YFT2_6375_wts1, YFT2_6375_wts2, YFT2_6375_wts3, YFT2_6375_wts4, YFT2_6375_wts5, YFT2_6375_wts8))
a <- a[,c(NA,7,3,4,5,6)]
a[,-1] <- t(t(a[,-1]) / yrng6375)
a <- a / apply(a,1,max, na.rm = TRUE)
colnames(a) <- c("", paste0("R", c("2N", "2S", 3,4,5)))
barplot(a, beside=TRUE, names.arg = colnames(a), legend.text = legtxt, args.legend = list(x="topleft"), main = "YFT 1963 - 1975")
savePlot("barplotadj_YFT_wts_6375", type = "png")

windows()
a<- with(allwts, rbind(YFT2_6075_wts1, YFT2_6075_wts2, YFT2_6075_wts3, YFT2_6075_wts4, YFT2_6075_wts5, YFT2_6075_wts8))
a <- a[,c(NA,8,3,4,5,6)]
a[,-1] <- t(t(a[,-1]) / yrng6075)
a <- a / apply(a,1,max, na.rm = TRUE)
colnames(a) <- c("", paste0("R", c("2N", "2S", 3,4,5)))
barplot(a, beside=TRUE, names.arg = colnames(a), legend.text = legtxt, args.legend = list(x="topleft"), main = "YFT 1960 - 1975")
savePlot("barplotadj_YFT_wts_6075", type = "png")

windows()
a<- with(allwts, rbind(YFT2_8000_wts1, YFT2_8000_wts2, YFT2_8000_wts3, YFT2_8000_wts4, YFT2_8000_wts5, YFT2_8000_wts8))
a <- a[,c(NA,8,3,4,5,6)]
a[,-1] <- t(t(a[,-1]) / yrng8000)
a <- a / apply(a,1,max, na.rm = TRUE)
colnames(a) <- c("", paste0("R", c("2N", "2S", 3,4,5)))
barplot(a, beside=TRUE, names.arg = colnames(a), legend.text = legtxt, args.legend = list(x="topleft"), main = "YFT 1980 - 2000")
savePlot("barplotadj_YFT_wts_8000", type = "png")

windows()
a<- with(allwts, rbind(BET3_6075_wts1,BET3_6075_wts2,BET3_6075_wts3,BET3_6075_wts4,BET3_6075_wts5,BET3_6075_wts8))
a <- a[,c(6,2,3,4,5)-1]
sth <- apply(a[,4:5],1,sum)
a <- cbind(a[,1:3], sth)
a <- t(t(a) / brng6075)
a <- a / apply(a,1,max)
colnames(a) <- paste0("R", c("1N", "1S", 2,3))
barplot(a, beside=TRUE, names.arg = colnames(a), legend = legtxt, args.legend = list(x="topleft"), main = "BET 1960 - 1975")
savePlot("barplotadj_BET_means_6075", type = "png")

windows()
a<- with(allwts, rbind(BET3_6375_wts1,BET3_6375_wts2,BET3_6375_wts3,BET3_6375_wts4,BET3_6375_wts5,BET3_6375_wts8))
a <- a[,c(6,2,3,4,5)]
sth <- apply(a[,4:5],1,sum)
a <- cbind(a[,1:3], sth)
a <- t(t(a) / brng6375)
a <- a / apply(a,1,max)
colnames(a) <- paste0("R", c("1N", "1S", 2,3))
barplot(a, beside=TRUE, names.arg = colnames(a), legend = legtxt, args.legend = list(x="topleft"), main = "BET 1963 - 1975")
savePlot("barplotadj_BET_means_6375", type = "png")

windows()
a<- with(allwts, rbind(BET3_8000_wts1,BET3_8000_wts2,BET3_8000_wts3,BET3_8000_wts4,BET3_8000_wts5,BET3_8000_wts8))
a <- a[,c(6,2,3,4,5)]
sth <- apply(a[,4:5],1,sum)
a <- cbind(a[,1:3], sth)
a <- t(t(a) / brng8000)
a <- a / apply(a,1,max)
colnames(a) <- paste0("R", c("1N", "1S", 2,3))
barplot(a, beside=TRUE, names.arg = colnames(a), legend = legtxt, args.legend = list(x="topleft"), main = "BET 1980 - 2000")
savePlot("barplotadj_BET_means_8000", type = "png")


papi.epc <- function(expr, event)
{
  papi.check.ncounters(3L)

  ret <- .Call(papi_epc_on, event)
  if (ret == -1L)
    stop("PAPI failed to initialize hardware counters.\nYour platform may not support floating point operation event.\n")

  eval(expr)

  ret <- .Call(papi_epc_off, event)
  if (is.integer(ret) && ret == -1L)
    stop("There was a problem recovering the counter information.")

  return( ret )
}

#' epc
#'
#' Events per cycle.
#'
#' This function measures the evaluation of the provided expression, expr, for
#' real time, process time, reference clock cycles since last call, core clock
#' cycles since last call, total events since first call, and incremental
#' events per cycle since last call. The additional arguments, gcFirst and
#' burnin, can be toggled to better simulate the target context.
#'
#' @param expr
#' A valid R expression to be profiled.
#' @param event
#' A PAPI event counter.
#' @param gcFirst
#' logical; determines if garbage collection should be called
#' before profiling.
#' @param burnin
#' logical; determines if the function should first be evaluated
#' with an empty expression.
#'
#' @return
#' The return is a list consisting of:
#' \tabular{ll}{
#'    \code{real_time} \tab real time spent evaluating expression \cr
#'    \code{proc_time} \tab total process time spent evaluating expression \cr
#'    \code{ref} \tab Incremental reference clock cycles since last call. \cr
#'    \code{core} \tab Incremental clock cycles since last call. \cr
#'    \code{evt} \tab Total events since first call. \cr
#'    \code{epc} \tab Incremental events per cycle since last call. \cr
#' }
#'
#' @keywords programming
#'
#' @examples
#' \dontrun{
#' library(pbdPAPI)
#'
#' system.epc(1+1,"PAPI_L1_DCM")
#' }
#'
#' @export
system.epc <- function(expr, event, gcFirst=TRUE, burnin=TRUE)
{
  if (burnin)
    b <- system.epc(event=event, gcFirst=gcFirst, burnin=FALSE)

  if (gcFirst)
    invisible(gc(FALSE))

  if (missing(expr))
    expr <- NULL

  papi.avail.lookup(events=event, shorthand=FALSE)
  event.num <- papi.event.init(which=event)

  ret <- papi.epc(expr=expr, event=event.num)

  if (burnin)
  {
    for (i in 3:length(ret))
      ret[[i]] <- max(ret[[i]] - b[[i]], 0)
  }

  return( ret )
}


#' Randomizes given community data and calculates MPD.
#'
#' @param cdm Community data matrix.
#' @param dist A matrix of phylogenetic or functional distances.
#' @param ab Boolean, indicates, if abundances should be weighted.
#'
#' @return Value of MPD.
#' @export
#'
#' @examples
#' rand.mpd(cdm, dist, ab = F)

rand.mpd <- function(cdm, dist, ab = F)
{
  perm <- sample(nrow(dist))
  colnames(cdm) <- colnames(cdm)[perm]
  mpd(cdm, dist, ab)
}


#' Convert output from query to TwoSampleMR format
#'
#' @param x Output from ieugwasr query e.g. associations, tophits, phewas
#' @param type "exposure" (default) or "outcome"
#'
#' @export
#' @return data frame
ieugwasr_to_TwoSampleMR <- function(x, type="exposure")
{
	stopifnot(type %in% c("exposure", "outcome"))
	stopifnot(is.data.frame(x))
	names(x) <- paste0(names(x), ".", type)
	nom <- names(x)
	names(x)[nom == paste0("rsid.", type)] <- "SNP"
	names(x)[nom == paste0("ea.", type)] <- paste0("effect_allele.", type)
	names(x)[nom == paste0("nea.", type)] <- paste0("other_allele.", type)
	names(x)[nom == paste0("eaf.", type)] <- paste0("eaf.", type)
	names(x)[nom == paste0("p.", type)] <- paste0("pval.", type)
	names(x)[nom == paste0("n.", type)] <- paste0("samplesize.", type)
	names(x)[nom == paste0("trait.", type)]	<- type

	x[[paste0("mr_keep.", type)]] <- !is.na(x[[paste0("beta.", type)]]) & !is.na(x[[paste0("se.", type)]]) & !is.na(x[[paste0("effect_allele.", type)]]) & !is.na(x[["SNP"]])
	return(x)
}

#' Create exposure or outcome data format for TwoSampleMR from vcf
#'
#' @param vcf VCF object
#' @param type ="exposure" or "outcome"
#'
#' @export
#' @return data frame
gwasvcf_to_TwoSampleMR <- function(vcf, type="exposure")
{
	a <- vcf %>% gwasvcf::vcf_to_granges()
	S4Vectors::mcols(a)[["SNP"]] <- names(a)
	a <- dplyr::as_tibble(a)
	if(!"ES" %in% names(a)) a[["ES"]] <- NA
	if(!"SE" %in% names(a)) a[["SE"]] <- NA
	if(!"LP" %in% names(a)) a[["LP"]] <- NA
	if(!"SS" %in% names(a)) a[["SS"]] <- NA
	if(!"NC" %in% names(a)) a[["NC"]] <- NA
	if(!"id" %in% names(a)) a[["id"]] <- NA
	a[["LP"]] <- 10^-a[["LP"]]
	a[["NCONT"]] <- a[["SS"]] - a[["NC"]]
	TwoSampleMR::format_data(
		a, type=type,
		snp_col="SNP",
		effect_allele_col="ALT",
		other_allele_col="REF",
		eaf_col="AF",
		chr_col="seqnames",
		pos_col="start",
		beta_col="ES",
		se_col="SE",
		pval_col="LP",
		samplesize_col="SS",
		ncase_col="NC",
		ncontrol_col="NCONT",
		phenotype_col="id"
	)
}


#' Exact File Sampler
#'
#' Randomly sample lines from an input text file.
#'
#' @details
#' The sampling is done in two passes of the input file.  First, the number of
#' lines of the input file are determined by scanning through the file as
#' quickly as possible (i.e., it should be completely I/O bound).  Next, an
#' index of lines to keep is produced by reservoir sampling.  Then finally,  the
#' input file is scanned again line by line with the chosen lines dumped into a
#' temporary file.
#'
#' If the output file (the one pointed to by the return of this function) is
#' "large" and to be read into memory (which isn't really appropriate for text
#' files in the first place!), then this strategy is probably not appropriate.
#'
#' @param nlines
#' The (exact) number of lines to sample from the input file.
#' @param infile
#' Location of the file (as a string) to be subsampled.
#' @param outfile
#' Output file location (as a string).
#' @param header
#' Is a header (line of column names) on the first line of the csv file?
#' @param nskip
#' Number of lines to skip. If \code{header=TRUE}, then this only applies to
#' lines after the header.
#' @param verbose
#' Should linecounts of the input file and the number of lines sampled be
#' printed?
#'
#' @return
#' \code{NULL}
#'
#' @useDynLib filesampler R_fs_sample_exact
#' @export
file_sample_exact = function(nlines, infile, outfile=tempfile(), header=TRUE, nskip=0, verbose=FALSE)
{
  check.is.posint(nlines)
  check.is.string(infile)
  infile = abspath(infile)
  check.is.string(outfile)
  check.is.flag(header)
  check.is.natnum(nskip)
  check.is.flag(verbose)

  .Call(R_fs_sample_exact, as.integer(verbose), as.integer(header), as.integer(nskip), as.integer(nlines)-1L, infile, outfile)

  invisible()
}