# lhl_wrapper.r

lhl_wrapper <- function(list_Ss,
                        sessions,
                        path_read,
                        rp_index,
                        trial_duration){

  last_n_list <- last_n_ses(list_Ss=list_Ss,
                            n=sessions,
                            path_read=path_read)

  lapply(last_n_list, function(k){

    df_2 <- read_sep_by_lever(k,1) %>% as.data.frame()

    if (!is_empty(df_2)) {

      df_2 <- df_2[df_2$evento %in% rp_index, ]
      # print(k)

      cde <- unique(df_2$cde)
      subj <- unique(df_2$sujeto)
      sess <- unique(df_2$sesion)
      met2 <- data.frame()
      tcheck <- unique(df_2$trial)

      if (length(tcheck) > 0) {

        if (length(cde) > 1) {

          for (l in cde) {

            l <- cde[l]
            df_3 <- df_2[df_2$cde == l, ]
            trials <- unique(df_3$trial)

            for(j in 1:length(trials)){

              df_4 <- df_3[df_3$trial == j,]
              r_times <- df_4$cum_dt

              if(length(r_times) > 3){

                # print(paste(k,l,j)) # for debbuging

                met <- lhl(r_times, trial_duration)
                met$trial <- j
                met$cde <- l
                met$sujeto <- subj
                met$sesion <- sess

              } else {
                met <- data.frame()
              }
              met2 <- bind_rows(met,met2)
            }
          }
        }
        met2
      }
    }
  }) %>% bind_rows()
}


# Code for working with individual-level rodent data
# movement with stakes

library(calibrate)
library(fields)

#---------------------------------------------------------------------------------
#          setup - select wd, import data, source code,  file to collect results
#---------------------------------------------------------------------------------
#set working directory
wd = "/Users/sarah/Documents/GitHub/portal-rodent-dispersal"
setwd(wd)
source("movement_fxns.R")

#import all data
all = read.table('rawdata/all_1980-2009.txt', sep = ',')

#import the data by guild
allrats = read.csv("rawdata//allrodents_1978-2012.csv") #all rodents, for temporal figure
het = read.csv("rawdata//heteromyids_2000-2009.csv")   # DO, DM, PB, PP, PF
cricet = read.csv("rawdata//cricetids_2000-2009.csv")  # PE, PM, RM
foliv = read.csv("rawdata//folivores_2000-2009.csv")   # SH, SF, NA (as NAO)
insec = read.csv("rawdata//onychomys_2000-2009.csv")   # OT, OL

# output directed to rodent_results.txt in wd. output is appended
# to existing file. output also sent to terminal.
#sink("rodent_results.txt", append=TRUE, split=TRUE)

#---------------------------------------------------------------------------------
#          clean up the data
#---------------------------------------------------------------------------------

# change some cols from factor to character class
het$tag = as.character(het$tag); cricet$tag = as.character(cricet$tag); foliv$tag = as.character(foliv$tag); insec$tag = as.character(insec$tag)
het$species = as.character(het$species); cricet$species = as.character(cricet$species); foliv$species = as.character(foliv$species); insec$species = as.character(insec$species)
het$sex = as.character(het$sex); cricet$sex = as.character(cricet$sex); foliv$sex = as.character(foliv$sex); insec$sex = as.character(insec$sex)

# give untagged individuals a unique 7-number code
het = id_unknowns(het, 16); cricet = id_unknowns(cricet, 16); foliv = id_unknowns(foliv, 16); insec = id_unknowns(insec, 16)

# get rid of 'bad data'; deletes data that is not a pit tag, where sex is inconsistent or where species is inconsistent.
het = subsetDat(het); cricet = subsetDat(cricet); foliv = subsetDat(foliv); insec = subsetDat(insec)

#---------------------------------------------------------------------------------
#          calculate life-history details - reproduction, temporal persistence
#---------------------------------------------------------------------------------

#average proportion of reproductive females by month across all years
doreprd = mean_mo_repro(subset(het, species == "DO" & sex == "F")); dmreprd = mean_mo_repro(subset(het, species == "DM" & sex == "F")); pfreprd = mean_mo_repro(subset(het, species == "PF" & sex == "F")); ppreprd = mean_mo_repro(subset(het, species == "PP" & sex == "F")); pbreprd = mean_mo_repro(subset(het, species == "PB" & sex == "F"));
pereprd = mean_mo_repro(subset(cricet, species == "PE" & sex == "F")); pmreprd = mean_mo_repro(subset(cricet, species == "PM" & sex == "F")); rmreprd = mean_mo_repro(subset(cricet, species == "RM" & sex == "F"))
shreprd = mean_mo_repro(subset(foliv, species == "SH" & sex == "F")); sfreprd = mean_mo_repro(subset(foliv, species == "SF" & sex == "F")); naoreprd = mean_mo_repro(subset(foliv, species == "NAO" & sex == "F"))
otreprd = mean_mo_repro(subset(insec, species == "OT" & sex == "F")); olreprd = mean_mo_repro(subset(insec, species == "OL" & sex == "F"))

# proportion of reproductive females by month and year
doreprdyr = mo_repro(subset(het, species == "DO" & sex == "F")); dmreprdyr = mo_repro(subset(het, species == "DM" & sex == "F")); pfreprdyr = mo_repro(subset(het, species == "PF" & sex == "F")); ppreprdyr = mo_repro(subset(het, species == "PP" & sex == "F")); pbreprdyr = mo_repro(subset(het, species == "PB" & sex == "F"));
pereprdyr = mo_repro(subset(cricet, species == "PE" & sex == "F")); pmreprdyr = mo_repro(subset(cricet, species == "PM" & sex == "F")); rmreprdyr = mo_repro(subset(cricet, species == "RM" & sex == "F"))
shreprdyr = mo_repro(subset(foliv, species == "SH" & sex == "F")); sfreprdyr = mo_repro(subset(foliv, species == "SF" & sex == "F")); naoreprdyr = mo_repro(subset(foliv, species == "NAO" & sex == "F"))
otreprdyr = mo_repro(subset(insec, species == "OT" & sex == "F")); olreprdyr = mo_repro(subset(insec, species == "OL" & sex == "F"))

#track the number of times females uniquely reproduce within years
doirep = indiv_repro(subset(het, species == "DO" & sex == "F")); dmirep = indiv_repro(subset(het, species == "DM" & sex == "F")); pfirep = indiv_repro(subset(het, species == "PF" & sex == "F")); ppirep = indiv_repro(subset(het, species == "PP" & sex == "F")); pbirep = indiv_repro(subset(het, species == "PB" & sex == "F"));
peirep = indiv_repro(subset(cricet, species == "PE" & sex == "F")); pmirep = indiv_repro(subset(cricet, species == "PM" & sex == "F")); rmirep = indiv_repro(subset(cricet, species == "RM" & sex == "F"))
shirep = indiv_repro(subset(foliv, species == "SH" & sex == "F")); sfirep = indiv_repro(subset(foliv, species == "SF" & sex == "F")); naoirep = indiv_repro(subset(foliv, species == "NAO" & sex == "F"))
otirep = indiv_repro(subset(insec, species == "OT" & sex == "F")); olirep = indiv_repro(subset(insec, species == "OL" & sex == "F"))

#proportion of years they were seen in
doyr = length(unique(het[het$species=="DO",]$yr))/10; dmyr = length(unique(het[het$species=="DM",]$yr))/10; pfyr = length(unique(het[het$species=="PF",]$yr))/10; ppyr = length(unique(het[het$species=="PP",]$yr))/10; pbyr = length(unique(het[het$species=="PB",]$yr))/10
peyr = length(unique(cricet[cricet$species=="PE",]$yr))/10; pmyr = length(unique(cricet[cricet$species=="PM",]$yr))/10; rmyr = length(unique(cricet[cricet$species=="RM",]$yr))/10
shyr = length(unique(foliv[foliv$species=="SH",]$yr))/10; sfyr = length(unique(foliv[foliv$species=="SF",]$yr))/10; naoyr = length(unique(foliv[foliv$species=="NAO",]$yr))/10
otyr = length(unique(insec[insec$species=="OT",]$yr))/10; olyr = length(unique(insec[insec$species=="OL",]$yr))/10

# average number of months they were seen in during years in which they were present
domo = mean_win_yr_occ(subset(het, species == "DO")); dmmo = mean_win_yr_occ(subset(het, species == "DM")); pfmo = mean_win_yr_occ(subset(het, species == "PF")); ppmo = mean_win_yr_occ(subset(het, species == "PP")); pbmo = mean_win_yr_occ(subset(het, species == "PB"))
pemo = mean_win_yr_occ(subset(cricet, species == "PE")); pmmo = mean_win_yr_occ(subset(cricet, species == "PM")); rmmo = mean_win_yr_occ(subset(cricet, species == "RM"))
shmo = mean_win_yr_occ(subset(foliv, species == "SH")); sfmo = mean_win_yr_occ(subset(foliv, species == "SF")); naomo = mean_win_yr_occ(subset(foliv, species == "NAO"))
otmo = mean_win_yr_occ(subset(insec, species == "OT")); olmo = mean_win_yr_occ(subset(insec, species == "OL"))

#mean abundance within all years
doabun = allyrs_abun(subset(het, species == "DO")); dmabun = allyrs_abun(subset(het, species == "DM")); pfabun = allyrs_abun(subset(het, species == "PF")); ppabun = allyrs_abun(subset(het, species == "PP")); pbabun = allyrs_abun(subset(het, species == "PB"))
peabun = allyrs_abun(subset(cricet, species == "PE")); pmabun = allyrs_abun(subset(cricet, species == "PM")); rmabun = allyrs_abun(subset(cricet, species == "RM"))
shabun = allyrs_abun(subset(foliv, species == "SH")); sfabun = allyrs_abun(subset(foliv, species == "SF")); naoabun = allyrs_abun(subset(foliv, species == "NAO"))
otabun = allyrs_abun(subset(insec, species == "OT")); olabun = allyrs_abun(subset(insec, species == "OL"))

abuns = cbind(doabun, dmabun, pbabun, ppabun, pfabun, peabun, pmabun, rmabun, shabun, sfabun, naoabun, otabun, olabun)

#mean abundances within all years on control plots only
doabun = allyrs_abun(subset(het, species == "DO" & plot %in% c(1,2,4,8,9,11,12,14,17,22))); dmabun = allyrs_abun(subset(het, species == "DM"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); pfabun = allyrs_abun(subset(het, species == "PF"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); ppabun = allyrs_abun(subset(het, species == "PP"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); pbabun = allyrs_abun(subset(het, species == "PB"& plot %in% c(1,2,4,8,9,11,12,14,17,22)))
peabun = allyrs_abun(subset(cricet, species == "PE"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); pmabun = allyrs_abun(subset(cricet, species == "PM"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); rmabun = allyrs_abun(subset(cricet, species == "RM"& plot %in% c(1,2,4,8,9,11,12,14,17,22)))
shabun = allyrs_abun(subset(foliv, species == "SH"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); sfabun = allyrs_abun(subset(foliv, species == "SF"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); naoabun = allyrs_abun(subset(foliv, species == "NAO"& plot %in% c(1,2,4,8,9,11,12,14,17,22)))
otabun = allyrs_abun(subset(insec, species == "OT"& plot %in% c(1,2,4,8,9,11,12,14,17,22))); olabun = allyrs_abun(subset(insec, species == "OL"& plot %in% c(1,2,4,8,9,11,12,14,17,22)))

conabuns = cbind(doabun, dmabun, pbabun, ppabun, pfabun, peabun, pmabun, rmabun, shabun, sfabun, naoabun, otabun, olabun)

#---------------------------------------------------------------------------------
#          calculate movement distances, multi-state capture histories
#---------------------------------------------------------------------------------

# get a vector unique tags, then get a vector of distances moved for all recaptured individuals, by SPECIES
  #heteromyids
    dmtags = unique(het[het$species == "DM",]$tag); dotags = unique(het[het$species == "DO",]$tag); pbtags = unique(het[het$species == "PB",]$tag); pptags = unique(het[het$species == "PP",]$tag); pftags = unique(het[het$species == "PF",]$tag)
    dmmeters = distance_moved(het[het$species == "DM",], dmtags); dometers = distance_moved(het[het$species == "DO",], dotags); pbmeters = distance_moved(het[het$species == "PB",], pbtags); ppmeters = distance_moved(het[het$species == "PP",], pptags); pfmeters = distance_moved(het[het$species == "PF",], pftags)
#cricetids
    petags = unique(cricet[cricet$species == "PE",]$tag); pmtags = unique(cricet[cricet$species == "PM",]$tag); rmtags = unique(cricet[cricet$species == "RM",]$tag)
    pemeters = distance_moved(cricet[cricet$species == "PE",], petags); pmmeters = distance_moved(cricet[cricet$species == "PM",], pmtags); rmmeters = distance_moved(cricet[cricet$species == "RM",], rmtags)
#folivores
    shtags = unique(foliv[foliv$species == "SH",]$tag); sftags = unique(foliv[foliv$species == "SF",]$tag); naotags = unique(foliv[foliv$species == "NAO",]$tag)
    shmeters = distance_moved(foliv[foliv$species == "SH",], shtags); sfmeters = distance_moved(foliv[foliv$species == "SF",], sftags); naometers = distance_moved(foliv[foliv$species == "NAO",], naotags)
#insectivores
    oltags = unique(insec[insec$species == "OL",]$tag); ottags = unique(insec[insec$species == "OT",]$tag)
    olmeters = distance_moved(insec[insec$species == "OL",], oltags); otmeters = distance_moved(insec[insec$species == "OT",], ottags)

# concatenate distance vectors for recaptured individuals by GUILD
Hgran = c(dmmeters, dometers, pbmeters, ppmeters, pfmeters)
Cgran = c(pemeters, pmmeters, rmmeters)
foli = c(shmeters, sfmeters) #separate NAO because they use different strategy - MIDDENS
insectiv = c(otmeters, olmeters)

corehet = c(dmmeters, dometers, pbmeters, ppmeters)

all = c(Hgran, Cgran, foli, naometers, insectiv)

# find breakpoints to use in MARK data structure for future analyses
# data reasonably well fits a lognormal distribution (eyeball and J. Powell)
# breakpoint = mean(logdata) + sd(logdata) of all the distances traveled by recaptured individuals
  # using log1p, and back transforming using expm1 should solve the problem of lots of zeros
corehet_brkpt = expm1(mean(log1p(corehet)) + sd(log1p(corehet)))
Hgran_brkpt = expm1(mean(log1p(Hgran)) + sd(log1p(Hgran)))
Cgran_brkpt = expm1(mean(log1p(Cgran)) + sd(log1p(Cgran)))
foli_brkpt = expm1(mean(log1p(foli)) + sd(log1p(foli)))
nao_brkpt = expm1(mean(log1p(naometers)) + sd(log1p(naometers)))
ins_brkpt = expm1(mean(log1p(insectiv)) + sd(log1p(insectiv)))

allbrk = expm1(mean(log1p(all)) + sd(log1p(all)))

# Get MARK capture histories
## add unique breakpoints for each species based on histogram data of movement
periods = c(261:380)
exclosures = c(5, 7, 10, 16, 23, 24)
krat_excl = c(5, 7, 10, 16, 23, 24, 3, 6, 13, 15, 18, 19, 20, 21)
DO_MARK = noplacelikehome(subset(het, species == "DO"), periods, krat_excl, corehet_brkpt)
DM_MARK = noplacelikehome(subset(het, species == "DM"), periods, krat_excl, corehet_brkpt)
PB_MARK = noplacelikehome(subset(het, species == "PB"), periods, exclosures, corehet_brkpt)
PP_MARK = noplacelikehome(subset(het, species == "PP"), periods, exclosures, corehet_brkpt)
PF_MARK = noplacelikehome(subset(het, species == "PF"), periods, exclosures, corehet_brkpt)

PE_MARK = noplacelikehome(subset(cricet, species == "PE"), periods, exclosures, corehet_brkpt)
PM_MARK = noplacelikehome(subset(cricet, species == "PM"), periods, exclosures, corehet_brkpt)
RM_MARK = noplacelikehome(subset(cricet, species == "RM"), periods, exclosures, corehet_brkpt)

SH_MARK = noplacelikehome(subset(foliv, species == "SH"), periods, exclosures, corehet_brkpt)
SF_MARK = noplacelikehome(subset(foliv, species == "SF"), periods, exclosures, corehet_brkpt)
NAO_MARK = noplacelikehome(subset(foliv, species == "NAO"), periods, exclosures, corehet_brkpt)

OT_MARK = noplacelikehome(subset(insec, species == "OT"), periods, exclosures, corehet_brkpt)
OL_MARK = noplacelikehome(subset(insec, species == "OL"), periods, exclosures, corehet_brkpt)

#---------------------------------------------------------------------------------
#          write files to folder for later analysis using RMark - .inp required
#---------------------------------------------------------------------------------

#write files to local folder
# write.table(DO_MARK, file = "mark_datafiles//do_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(DM_MARK, file = "mark_datafiles//dm_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(PB_MARK, file = "mark_datafiles//pb_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(PP_MARK, file = "mark_datafiles//pp_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(PF_MARK, file = "mark_datafiles//pf_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(PE_MARK, file = "mark_datafiles//pe_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(PM_MARK, file = "mark_datafiles//pm_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(RM_MARK, file = "mark_datafiles//rm_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(SH_MARK, file = "mark_datafiles//sh_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(SF_MARK, file = "mark_datafiles//sf_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(NAO_MARK, file = "mark_datafiles//nao_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(OT_MARK, file = "mark_datafiles//ot_mark.inp", row.names = F, col.names = F, quote = F)
# write.table(OL_MARK, file = "mark_datafiles//ol_mark.inp", row.names = F, col.names = F, quote = F)

allspp = rbind(DO_MARK, DM_MARK, PB_MARK, PP_MARK, PF_MARK, PE_MARK, PM_MARK, RM_MARK, SH_MARK, SF_MARK, NAO_MARK, OT_MARK, OL_MARK)
write.table(allspp, file = "mark_datafiles//all_mark.inp", row.names = F, col.names = F, quote = F)

#---------------------------------------------------------------------------------
#          plot results
#---------------------------------------------------------------------------------

#------------------------------------------ FIGURE 2
pdf("Fig2_temporal_occ_spp_rank.pdf", 5, 5, pointsize = 10)
par(mfrow=c(1,1))

#average rank of each species 2000-2009 on control plots
#ordered: DM, DO, PB, PP, PF, PE, PM, RM, SH, SF, NA, OT, OL
conranks = c(2.9, 4, 2.6, 1, 7.875, 7.1, 9.8, 9.333, 9, 8.6, 8.5, 4.8, 10.5)

plot(conranks[5], pfyr, xlim = c(1,13), ylim = c(0,1), xlab = "species average ranked abundance",
     ylab = "proportion of years present", pch = 19, col = "black", cex = 1.5, cex.axis = 1.5, cex.lab = 1.5)
  textxy(conranks[5], pfyr, "PF", cx = 1)
points(conranks[4],ppyr, pch = 19, col = "black", cex = 1.5)
  textxy(conranks[4],ppyr, "CP", cx = 1)
points(conranks[2], doyr, pch = 19, col = "black", cex = 1.5)
  textxy(conranks[2], doyr, "DO", cx = 1)
points(conranks[1], dmyr, pch = 19, col = "black", cex = 1.5)
  textxy(conranks[1], dmyr, "DM", cx = 1)
points(conranks[3], pbyr, pch = 19, col = "black", cex = 1.5)
  textxy(conranks[3], pbyr, "CB", cx = 1)
points(conranks[6], peyr, pch = 19, col = "gray30", cex = 1.5)
  textxy(conranks[6], peyr, "PE", cx = 1)
points(conranks[7], pmyr, pch = 19, col = "gray30", cex = 1.5)
  textxy(conranks[7], pmyr, "PM", cx = 1)
points(conranks[8], rmyr, pch = 19, col = "gray30", cex = 1.5)
  textxy(conranks[8], rmyr, "RM", cx = 1)
points(conranks[12], otyr, pch = 6, col = "gray30", cex = 1.5)
  textxy(conranks[12], otyr, "OT", cx = 1)
points(conranks[13], olyr, pch = 6, col = "gray30", cex = 1.5)
  textxy(conranks[13], olyr, "OL", cx = 1)
points(conranks[9], shyr, pch = 0, col = "gray30", cex = 1.5)
  textxy(conranks[9], shyr, "SH", cx = 1)
points(conranks[10], sfyr, pch = 0, col = "gray30", cex = 1.5)
  textxy(conranks[10], sfyr, "SF", cx = 1)
points(conranks[11], naoyr, pch = 0, col = "gray30", cex = 1.5)
  textxy(conranks[11], naoyr, "NA", cx = 1)

abline(v = 5, lty = 2, col = 'gray40', lwd = 1)
abline(h = 0.95, lty = 2, col = 'gray40', lwd = 1)

dev.off()

#------------------------------------------ FIGURE 3
pdf("Fig3_indiv_repro_trends.pdf", 6, 6, pointsize = 10)
par(mfrow=c(2,2))

#plot the relative abundance of females who represent each number of reproductive events per year
plot(NA, NA, xlim = c(0, 4), xaxp = c(0, 4, 4), xlab = "number reproductive events per year",
     ylab = "proportion females", type = "b", pch = 19, ylim = c(0, 1), yaxp = c(0, 1, 4), bty = "n",
     main = "heteromyid granivores", cex.axis = 1.5, cex.lab = 1.5)
points(c(0:3), table(doirep$num_reprod)/sum(table(doirep$num_reprod)), type = "b", pch = 19, col = "black")
points(c(0:4), table(dmirep$num_reprod)/sum(table(dmirep$num_reprod)), type = "b", pch = 15, col = "black")
points(c(0:4), table(pbirep$num_reprod)/sum(table(pbirep$num_reprod)), type = "b", pch = 17, col = "black")
points(c(0:4), table(ppirep$num_reprod)/sum(table(ppirep$num_reprod)), type = "b", pch = 25, col = "black")
points(c(0:2), table(pfirep$num_reprod)/sum(table(pfirep$num_reprod)), type = "b", pch = 24, col = "black")
legend('topright', c('DO', 'DM', 'CB', 'CP', 'PF'), bty = 'n',
       col = 'black', pch = c(19,15,17,25,24), cex = 0.75)

plot(NA, NA, xlim = c(0, 4), xaxp = c(0, 4, 4), xlab = "number reproductive events per year",
     ylab = "proportion females", type = "b", pch = 19, ylim = c(0, 1), yaxp = c(0, 1, 4), bty = "n",
     main = "cricetid granivores", cex.axis = 1.5, cex.lab = 1.5)
points(c(0:2), table(peirep$num_reprod)/sum(table(peirep$num_reprod)), type = "b", pch = 19, col = "black")
points(c(0:2), table(pmirep$num_reprod)/sum(table(pmirep$num_reprod)), type = "b", pch = 15, col = "black")
points(c(0:1), table(rmirep$num_reprod)/sum(table(rmirep$num_reprod)), type = "b", pch = 17, col = "black")
legend('topright', c('PE', 'PM', 'RM'), bty = 'n', col = 'black', pch = c(19,15,17), cex = 0.75)

plot(NA, NA, xlim = c(0, 4), xaxp = c(0, 4, 4), xlab = "number reproductive events per year",
     ylab = "proportion females", type = "b", pch = 19, ylim = c(0, 1), yaxp = c(0, 1, 4), bty = "n",
     main = "folivores", cex.axis = 1.5, cex.lab = 1.5)
points(c(0:1), table(shirep$num_reprod)/sum(table(shirep$num_reprod)), type = "b", pch = 19, col = "black")
points(c(0:1), table(sfirep$num_reprod)/sum(table(sfirep$num_reprod)), type = "b", pch = 15, col = "black")
points(c(0:3), table(naoirep$num_reprod)/sum(table(naoirep$num_reprod)), type = "b", pch = 17, col = "black")
legend('topright', c('SH', 'SF', 'NA'), bty = 'n', col = 'black', pch = c(19,15,17), cex = 0.75)

plot(NA, NA, xlim = c(0, 4), xaxp = c(0, 4, 4), xlab = "number reproductive events per year", bty = "n",
     ylab = "proportion females", type = "b", pch = 19, ylim = c(0, 1), yaxp = c(0, 1, 4),
     main = "carnivores", cex.axis = 1.5, cex.lab = 1.5)
points(c(0:3), table(otirep$num_reprod)/sum(table(otirep$num_reprod)), type = "b", pch = 19, col = "black")
points(c(0:1), table(olirep$num_reprod)/sum(table(olirep$num_reprod)), type = "b", pch = 15, col = "black")
legend('topright', c('OT', 'OL'), bty = 'n', col = 'black', pch = c(19,15), cex = 0.75)

dev.off()

#------------------------------------------ FIGURE 3
pdf("Fig4_species_movement_hist.pdf", 10, 8, pointsize = 10)
par(mfrow=c(5,3), mar=c(3,1.5,2,0.5), oma=c(1.5,2,1,1))

#plot histogram of all consecutive movement for rodents within a species 2000-2009
#create vector of breaks, incrementing by 6 meters (represents approx. 1 stake) since data are not actually continuous
v6 = seq(-3,500,6)
docount = hist(dometers, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0, 350),
               xlab = "meters", main = 'DO - * - CORE')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(dometers)) + sd(log1p(dometers))), lty = 3, lwd = 2)

dmcount = hist(dmmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0, 500),
               xlab = "meters", main = 'DM - * - CORE')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(dmmeters)) + sd(log1p(dmmeters))), lty = 3, lwd = 2)

pbcount = hist(pbmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0, 2000),
               xlab = "meters", main = 'PB - * - CORE')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(pbmeters)) + sd(log1p(pbmeters))), lty = 3, lwd = 2)

ppcount = hist(ppmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0, 600),
               xlab = "meters", main = 'PP - * - CORE')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(ppmeters)) + sd(log1p(ppmeters))), lty = 3, lwd = 2)

otcount = hist(otmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,100),
               xlab = "meters", main = 'OT - CORE')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(otmeters)) + sd(log1p(otmeters))), lty = 3, lwd = 2)

pecount = hist(pemeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,25),
               xlab = "meters", main = 'PE - * - INT')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(pemeters)) + sd(log1p(pemeters))), lty = 3, lwd = 2)

rmcount = hist(rmmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,15),
               xlab = "meters", main = 'RM - * - INT')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(rmmeters)) + sd(log1p(rmmeters))), lty = 3, lwd = 2)

nacount = hist(naometers, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,25),
               xlab = "meters", main = 'NA - INT')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(naometers)) + sd(log1p(naometers))), lty = 3, lwd = 2)

pfcount = hist(pfmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0, 30),
               xlab = "meters", main = 'PF - * - TRANS')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(pfmeters)) + sd(log1p(pfmeters))), lty = 3, lwd = 2)

pmcount = hist(pmmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,15),
               xlab = "meters", main = 'PM - * - TRANS')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(pmmeters)) + sd(log1p(pmmeters))), lty = 3, lwd = 2)

shcount = hist(shmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,15),
               xlab = "meters", main = 'SH - TRANS')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(shmeters)) + sd(log1p(shmeters))), lty = 3, lwd = 2)

sfcount = hist(sfmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,15),
               xlab = "meters", main = 'SF - TRANS')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(sfmeters)) + sd(log1p(sfmeters))), lty = 3, lwd = 2)

olcount = hist(olmeters, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,15),
               xlab = "meters", main = 'OL - TRANS')
xline(corehet_brkpt, lwd = 2, col = "indianred")
xline(expm1(mean(log1p(olmeters)) + sd(log1p(olmeters))), lty = 3, lwd = 2)

dev.off()

#--------------------------------------------------------------
#           FIGURES NOT INCLUDED IN THE MAIN PAPER
#--------------------------------------------------------------
pdf("Fig1_guild_movement_hist.pdf", 8, 5, pointsize = 10)
par(mfrow=c(3,2), mar=c(3,1.5,2,0.5), oma=c(1.5,2,1,1))

#plot histogram of all consecutive movement for rodents within a species 2000-2009
#create vector of breaks, incrementing by 6 meters (represents approx. 1 stake) since data are not actually continuous
v6 = seq(-3,500,6)
Hgcount = hist(Hgran, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0, 3500),
               xlab = "meters", main = 'Heteromyids - PF, PP, PB, DO, DM')
            xline(Hgran_brkpt, lwd = 2, col = "indianred")
Cgcount = hist(Cgran, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,40),
               xlab = "meters", main = 'Cricetids - PE, PM, RM')
            xline(Cgran_brkpt, lwd = 2, col = "indianred")
focount = hist(foli, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,25),
               xlab = "meters", main = 'folivores - SH, SF')
            xline(foli_brkpt, lwd = 2, col = "indianred")
nacount = hist(naometers, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,25),
               xlab = "meters", main = 'neotoma - NA')
            xline(nao_brkpt, lwd = 2, col = "indianred")
incount = hist(insectiv, breaks = v6, col = 'gray60', xlim = c(0,500), ylim = c(0,120),
               xlab = "meters", main = 'insectivores - OT, OL')
            xline(ins_brkpt, lwd = 2, col = "indianred")
dev.off()

#NOTES: Hgran has no obvious breakpoint (everything stays "home"), minima at 54 (distance between plots?)
#       Cgran has a minima at 48 m (distance between plots?)
#       Foli has a minima at 48 m (artefact of about the distance to hit between plots?)
#       Na has a minima at 24, closer to where I would guess Hgran to be (middens, never really leaves?)
#       Insec has a minima at 60 m, greater than the distance across a plot (active hunters)

#------------------------------------------------------------
pdf("Fig2_avg_temporal_occ.pdf", 5, 5, pointsize = 10)
par(mfrow=c(1,1))

# Make an occupancy plot for 2000-2009 (similar to Morgan)
# plot temporal occupancy - for month and year
plot(pfyr, pfmo, xlim = c(0,1), ylim = c(0,1), xlab = "across-year occupancy 2000-2009", ylab = "within-year occupancy", pch = 19, col = "hotpink")
    textxy(pfyr, pfmo, "PF")
  points(ppyr, ppmo, pch = 19, col = "hotpink")
    textxy(ppyr, ppmo, "PP")
  points(pbyr, pbmo, pch = 19, col = "hotpink")
    textxy(pbyr, pbmo, "PB")
  points(doyr, domo, pch = 19, col = "hotpink")
    textxy(doyr, domo, "DO")
  points(dmyr, dmmo, pch = 19, col = "hotpink")
    textxy(dmyr, dmmo, "DM")
  points(peyr, pemo, pch = 19, col = "indianred4")
    textxy(peyr, pemo, "PE")
  points(pmyr, pmmo, pch = 19. col = "indianred4")
    textxy(pmyr, pmmo, "PM")
  points(rmyr, rmmo, pch = 19, col = "indianred4")
    textxy(rmyr, rmmo, "RM")
  points(otyr, otmo, pch = 17, col = "cadetblue4")
    textxy(otyr, otmo, "OT")
  points(olyr, olmo, pch = 17, col = "cadetblue4")
    textxy(olyr, olmo, "OL")
  points(shyr, shmo, pch = 17, col = "chartreuse3")
    textxy(shyr, shmo, "SH")
  points(sfyr, sfmo, pch = 17, col = "chartreuse3")
    textxy(sfyr, sfmo, "SF")
  points(naoyr, naomo, pch = 17, col = "chartreuse3")
    textxy(naoyr, naomo, "NA")
  abline(v = 0.5, lty = 2, col = 'gray40', lwd = 1)
  abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)
dev.off()

#---------------------------------------------
pdf("Fig3_avg_prop_reprodfemales.pdf", 7, 10, paper = "letter", pointsize = 10)
par(mfrow=c(5,3))

#plot mean fecundity by month for each species
plot(c(1:12), doreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "DO - krat")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), dmreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "DM - krat")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), pbreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "PB - pocket mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), ppreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "PP - pocket mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), pfreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "PF - pocket mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), pereprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "PE - cactus mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), pmreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "PM - deer mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), rmreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "RM - harvest mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), shreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "SH - cotton rat")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), sfreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "SF - cotton rat")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), naoreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "NA - pack rat")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), otreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "OT - grasshopper mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

plot(c(1:12), olreprd, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
     ylab = "proprotion reproductive fem.", bty = "n", main = "OL - grasshopper mouse")
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

dev.off()

#------------------------------------------
pdf("Fig4_abun_across_yrs.pdf", 8, 5, pointsize = 10)
par(mfrow=c(2,2), mar=c(2,2,2,0.5), oma=c(1.5,2,1,1))

years = c(2000:2009)

plot(years, doabun, type = "l", bty = "n", ylab = "", xlim = c(2000, 2010),
     ylim = c(0, 600), xaxp = c(2000, 2009, 9))
  points(years, dmabun, type = "l")
  points(years, pbabun, type = "l")
  points(years, ppabun, type = "l")
  points(years, pfabun, type = "l")
    mtext("Heteromyidae granivores", side = 3, adj = 0.15, line = -1)
    mtext("abundance", side = 2, line = 2)

plot(years, peabun, type = "l", bty = "n", ylab = "", xlim = c(2000, 2010),
     ylim = c(0, 600), xaxp = c(2000, 2009, 9))
points(years, pmabun, type = "l")
points(years, rmabun, type = "l")
    mtext("Cricetidae granivores", side = 3, adj = 0.15, line = -1)

plot(years, shabun, type = "l", bty = "n", ylab = "", xlim = c(2000, 2010),
     ylim = c(0, 600), xaxp = c(2000, 2009, 9))
points(years, sfabun, type = "l")
points(years, naoabun, type = "l")
    mtext("Folivores", side = 3, adj = 0.15, line = -1)
    mtext("abundance", side = 2, line = 2)
    mtext("years", side = 1, line = 2)

plot(years, otabun, type = "l", bty = "n", ylab = "", xlim = c(2000, 2010),
     ylim = c(0, 600), xaxp = c(2000, 2009, 9))
points(years, olabun, type = "l")
    mtext("Insectivores", side = 3, adj = 0.15, line = -1)
    mtext("years", side = 1, line = 2)

dev.off()

#------------------------------------------
pdf("Fig5_rank_abundance.pdf", 7, 10, paper = "letter", pointsize = 10)
par(mfrow=c(4,3))

years = c(2000:2009)
ranks = c(1:13)

#use data from control plots only
for (row in 1:nrow(conabuns)){
  yrdat = conabuns[row,]
  reldat = sort(yrdat/sum(yrdat), decreasing = TRUE)

  nonzero = reldat[reldat>0]
    labels = strtrim(as.character(names(nonzero)),2)
    print(labels)

  plot(ranks, reldat, type = "b", pch = 19, ylim = c(0,0.6),
       xlab = "Rank", ylab = "Relative Abundance", bty = "n", xaxp = c(1, 13, 12))
  mtext(years[row], side = 3)
  textxy(c(1:length(nonzero)), nonzero, labs = labels, cx = 0.75)
}

dev.off()

#------------------------------------------
pdf("Fig7_mo-yr_repro_trends.pdf", 7, 10, paper = "letter", pointsize = 10)
par(mfrow=c(4,3))

alldat = rbind(doreprdyr, dmreprdyr, pbreprdyr, ppreprdyr, pfreprdyr, pereprdyr, pmreprdyr, rmreprdyr,
               shreprdyr, sfreprdyr, naoreprdyr, otreprdyr, olreprdyr)

years = c(2000:2009)
spp = c("DO", 'DM', 'PB', 'PP', 'PF', 'PE', 'PM', 'RM', 'SH', 'NAO', 'OT', 'OL') #SF (fit all on a page, hardly reproduce anyway)

#plot proportion fecundity by month and year for each species
for (y in 1:length (years)){

  for (s in 1:length (spp)) {
    data = subset(alldat, year == years[y] & species == spp[s])

    if(nrow(data) > 0){

    plot(c(1:12), data$proprepro, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
       ylab = "prop. reproductive F", bty = "n", main =  paste(spp[s], years[y], sep = " "))
    abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

}
  else {
    plot(NA, NA, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
         ylab = "prop. reproductive F", bty = "n",  main = paste( "No", spp[s], years[y], sep = " "))
  }}}

dev.off()

#------------------------------------------
pdf("Fig8_histogram_masses.pdf", 6, 6, pointsize = 10)
par(mfrow=c(2,2))

v10 = seq(0,300,10)
hist(het$wgt, col = 'gray60', xlim = c(0,80), ylim = c(0, 3000), xlab = "grams",
     main = "Heteromyid mass")

hist(cricet$wgt, col = 'gray60', xlim = c(0,40), ylim = c(0, 500), xlab = "grams",
     main = "Cricetid granivore mass")

hist(foliv$wgt, col = 'gray60', xlim = c(0,300), ylim = c(0, 125), xlab = "grams",
     main = "folivore mass")

hist(insec$wgt, col = 'gray60', xlim = c(0,50), ylim = c(0, 800), xlab = "grams",
     main = "carnivore mass")

dev.off()

#------------------------------------------
#proportion of years they were seen in
doyr = length(unique(allrats[allrats$species=="DO",]$yr))/35; dmyr = length(unique(allrats[allrats$species=="DM",]$yr))/35; pfyr = length(unique(allrats[allrats$species=="PF",]$yr))/35; ppyr = length(unique(allrats[allrats$species=="PP",]$yr))/35; pbyr = length(unique(allrats[allrats$species=="PB",]$yr))/35
peyr = length(unique(allrats[allrats$species=="PE",]$yr))/35; pmyr = length(unique(allrats[allrats$species=="PM",]$yr))/35; rmyr = length(unique(allrats[allrats$species=="RM",]$yr))/35
shyr = length(unique(allrats[allrats$species=="SH",]$yr))/35; sfyr = length(unique(allrats[allrats$species=="SF",]$yr))/35; naoyr = length(unique(allrats[allrats$species=="NAO",]$yr))/35
otyr = length(unique(allrats[allrats$species=="OT",]$yr))/35; olyr = length(unique(allrats[allrats$species=="OL",]$yr))/35

# average number of months they were seen in during years in which they were present
domo = mean_win_yr_alldat(subset(allrats, species == "DO")); dmmo = mean_win_yr_alldat(subset(allrats, species == "DM")); pfmo = mean_win_yr_alldat(subset(allrats, species == "PF")); ppmo = mean_win_yr_alldat(subset(allrats, species == "PP")); pbmo = mean_win_yr_alldat(subset(allrats, species == "PB"))
pemo = mean_win_yr_alldat(subset(allrats, species == "PE")); pmmo = mean_win_yr_alldat(subset(allrats, species == "PM")); rmmo = mean_win_yr_alldat(subset(allrats, species == "RM"))
shmo = mean_win_yr_alldat(subset(allrats, species == "SH")); sfmo = mean_win_yr_alldat(subset(allrats, species == "SF")); naomo = mean_win_yr_alldat(subset(allrats, species == "NAO"))
otmo = mean_win_yr_alldat(subset(allrats, species == "OT")); olmo = mean_win_yr_alldat(subset(allrats, species == "OL"))

#mean abundance within all years
doabun = allyrs_abun(subset(allrats, species == "DO")); dmabun = allyrs_abun(subset(het, species == "DM")); pfabun = allyrs_abun(subset(het, species == "PF")); ppabun = allyrs_abun(subset(het, species == "PP")); pbabun = allyrs_abun(subset(het, species == "PB"))
peabun = allyrs_abun(subset(cricet, species == "PE")); pmabun = allyrs_abun(subset(cricet, species == "PM")); rmabun = allyrs_abun(subset(cricet, species == "RM"))
shabun = allyrs_abun(subset(foliv, species == "SH")); sfabun = allyrs_abun(subset(foliv, species == "SF")); naoabun = allyrs_abun(subset(foliv, species == "NAO"))
otabun = allyrs_abun(subset(insec, species == "OT")); olabun = allyrs_abun(subset(insec, species == "OL"))

# Make an occupancy plot for 1978-2012 (similar to Morgan)
# plot temporal occupancy - for month and year
pdf("Fig9_avg_temporal_occ_allyears.pdf", 5, 5, pointsize = 10)
par(mfrow=c(1,1))

plot(pfyr, pfmo, xlim = c(0,1), ylim = c(0,1), xlab = "across-year occupancy 1978-2012", ylab = "within-year occupancy", pch = 19, col = "hotpink")
textxy(pfyr, pfmo, "PF")
points(ppyr, ppmo, pch = 19, col = "hotpink")
textxy(ppyr, ppmo, "PP")
points(pbyr, pbmo, pch = 19, col = "hotpink")
textxy(pbyr, pbmo, "PB")
points(doyr, domo, pch = 19, col = "hotpink")
textxy(doyr, domo, "DO")
points(dmyr, dmmo, pch = 19, col = "hotpink")
textxy(dmyr, dmmo, "DM")
points(peyr, pemo, pch = 19, col = "indianred4")
textxy(peyr, pemo, "PE")
points(pmyr, pmmo, pch = 19, col = "indianred4")
textxy(pmyr, pmmo, "PM")
points(rmyr, rmmo, pch = 19, col = "indianred4")
textxy(rmyr, rmmo, "RM")
points(otyr, otmo, pch = 19, col = "cadetblue4")
textxy(otyr, otmo, "OT")
points(olyr, olmo, pch = 17, col = "cadetblue4")
textxy(olyr, olmo, "OL")
points(shyr, shmo, pch = 17, col = "chartreuse3")
textxy(shyr, shmo, "SH")
points(sfyr, sfmo, pch = 17, col = "chartreuse3")
textxy(sfyr, sfmo, "SH")
points(naoyr, naomo, pch = 17, col = "chartreuse3")
textxy(naoyr, naomo, "NA")

abline(v = 0.5, lty = 2, col = 'gray40', lwd = 1)
abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

dev.off()

#------------------------------------------------------
pdf("Fig12_avg_repro_trends_wpts.pdf", 7, 10, paper = "letter", pointsize = 10)
par(mfrow=c(5,3))

alldat = rbind(doreprdyr, dmreprdyr, pbreprdyr, ppreprdyr, pfreprdyr, pereprdyr, pmreprdyr, rmreprdyr,
               shreprdyr, sfreprdyr, naoreprdyr, otreprdyr, olreprdyr)

mos = c(1:12)
spp = c("DO", 'DM', 'PB', 'PP', 'PF', 'PE', 'PM', 'RM', 'SH', 'SF', 'NAO', 'OT', 'OL')

#plot proportion fecundity by month and year for each species
for (s in 1:length (spp)) {
  avg_repro = c()
  z = c() # for determining color of points

  for (m in 1:length (mos)){

    data = subset(alldat, month == mos[m] & species == spp[s])
    mo_repro = as.numeric(data$proprepro)
    mo_repro = mo_repro[!is.na(mo_repro)] #remove NAs from data

    if (length(mo_repro > 0)){
      avg = mean(mo_repro)

      if (avg >= 0.5) {
        prop_mos = length(mo_repro[mo_repro > 0.5])/length(mo_repro)  #proportion of months in which the spp was seen that had repro > 50%
        z = append(z, prop_mos)
      }
      else {
        z = append(z, NA)
      }
    }
      else {
      avg = NA }

    avg_repro = append(avg_repro, avg)
  }

  plot(mos, avg_repro, type = "l", xlim = c(1,12), ylim = c(0,1), pch = 19, xlab = "month",
         ylab = "proprotion reproductive fem.", bty = "n", main = spp[s])
    abline(h = 0.5, lty = 2, col = 'gray40', lwd = 1)

  points(mos, avg_repro, col = ifelse(z >=0.5, "indianred", "cadetblue"), pch = 19)
}

dev.off()

#-------------------------------------------------------------------
#          Print statments - descriptive info for the txt file
#-------------------------------------------------------------------

#close sink file
sink()
#

#
# ##------ histograms of the number of recaptures (some species are recaptured far less often), save in pdf file #FIXME
# pdf(file = "recaps_by_species.pdf", 11, 7.5)
# par(mfrow = c(2,4))
#
# plot_recap_hist(PB, "PB"); plot_recap_hist(PP, "PP"); plot_recap_hist(PF, "PF"); plot_recap_hist(DM, "DM"); plot_recap_hist(DO, "DO")
# plot_recap_hist(PE, "PE"); plot_recap_hist(PM, "PM"); plot_recap_hist(RM, "RM")
# plot_recap_hist(NAO, "NAO"); plot_recap_hist(SF, "SF"); plot_recap_hist(SH, "SH")
# plot_recap_hist(OT, "OT"); plot_recap_hist(OL, "OL")
#
# dev.off()


library(Giotto)

args <- commandArgs(trailingOnly = TRUE)
CPUs = as.integer(args[1])

set_up_giotto <- function(work_dir, instrs) {

    exp_path = fs::path(work_dir, "exp.txt")
    loc_path = fs::path(work_dir, "loc.txt")
    meta_path = fs::path(work_dir, "meta.txt")

    obj <- createGiottoObject(raw_exprs = exp_path,spatial_locs = loc_path,instructions = instrs)
    metadata = data.table::fread(file = meta_path)
    obj <- addCellMetadata(obj, new_metadata = metadata, by_column = T, column_cell_ID = 'cell_id')

    return(obj)
}

heat = FALSE
cell_num = c('1000', '2000', '5000', '10000', '50000')

nns_time = list(software=c(),cell_num=c(),exec_time=c(),exec_mem=c(),cpu_count=c())
cci_time = list(software=c(),cell_num=c(),exec_time=c(),exec_mem=c(),cpu_count=c())

python_path = "/usr/bin/python3"
results_folder = 'result/'

instrs = createGiottoInstructions(save_plot = FALSE,
                                  show_plot = FALSE,
                                  save_dir = results_folder,
                                  python_path = python_path)

for (c in cell_num) {
    write(sprintf("Running for %s \n", c), stdout())
    work_dir = sprintf('fake_data/data_%s', c)

    obj = set_up_giotto(work_dir, instrs)

    if (!heat) {
        temp_obj <- createSpatialKNNnetwork(gobject = obj, k=5, name = "knn_network",)
        temp_obj <- cellProximityEnrichment(gobject = temp_obj,
                                               cluster_column = 'cell_type',
                                                spatial_network_name = "knn_network",
                                               number_of_simulations = 500)
        heat = TRUE
    }

    for (i in 1:3) {
        Rprof(tf <- "rprof.log", memory.profiling = TRUE, interval = 0.01)

        start_nns = as.numeric(as.POSIXct(Sys.time()))
        temp_obj <- createSpatialKNNnetwork(gobject = obj, k=5, name = "knn_network",)
        end_nns = as.numeric(as.POSIXct(Sys.time()))

        Rprof(NULL)
        p <- summaryRprof(tf, memory="both")
        nns_mem_p <- max(p$by.total$mem.total)

        Rprof(tf <- "rprof.log", memory.profiling = TRUE, interval = 0.01)
        start_cci = as.numeric(as.POSIXct(Sys.time()))
        temp_obj <- cellProximityEnrichment(gobject = temp_obj,
                                           cluster_column = 'cell_type',
                                            spatial_network_name = "knn_network",
                                           number_of_simulations = 500)
        end_cci = as.numeric(as.POSIXct(Sys.time()))
        Rprof(NULL)
        p <- summaryRprof(tf, memory="both")
        cci_mem_p <- max(p$by.total$mem.total)

        write(sprintf("nns time is %s \n", end_nns - start_nns), stdout())
        nns_time$software <- append(nns_time$software, 'Giotto')
        nns_time$cell_num <- append(nns_time$cell_num, c)
        nns_time$exec_time <- append(nns_time$exec_time, end_nns - start_nns)
        nns_time$exec_mem <- append(nns_time$exec_mem, nns_mem_p)
        nns_time$cpu_count <- append(nns_time$cpu_count, CPUs)

        write(sprintf("cci time is %s \n", end_cci - end_nns), stdout())

        cci_time$software <- append(cci_time$software, 'Giotto')
        cci_time$cell_num <- append(cci_time$cell_num, c)
        cci_time$exec_time <- append(cci_time$exec_time, end_cci - start_cci)
        cci_time$exec_mem <- append(cci_time$exec_mem, cci_mem_p)
        cci_time$cpu_count <- append(cci_time$cpu_count, CPUs)
    }

    # in case of memory break
    write.csv(data.frame(nns_time), sprintf("result/giotto_nns_time_%score.csv", CPUs), quote=FALSE, row.names = FALSE)
    write.csv(data.frame(cci_time), sprintf("result/giotto_cci_time_%score.csv", CPUs), quote=FALSE, row.names = FALSE)

}


library(dplyr)
library(raster)
library(stringi)

# Set working directory to path of the script
setwd(dirname(rstudioapi::getSourceEditorContext()$path))

# Get the list of country names
countries <- list.files(path = '../results/', pattern = '[A-Z]{3}')

# Get the scenarios
scenarios <- list.dirs(path = file.path('..', 'results', countries[1]), recursive = F, full.names = F)

# Get the years
years <- list.files(path = file.path('..', 'results', countries[1], scenarios[1]))

# Loop through scenarios
for (scenario in scenarios) {
  # Loop through years
  for (year in years) {
    # Ensemble mean file name
    filename_mean <- stringi::stri_c(scenario, '_', year, '.tif')
    # List of results of all countries
    list_rst_mean <- list()
    for (i in 1:length(countries)) {
      rst_mean <- raster(file.path('..', 'results', countries[i], filename_mean))
      raster::crs(rst_mean) <- "+proj=moll +lon_0=0 +x_0=0 +y_0=0"
      list_rst_mean[i] <- rst_mean
    }
    # Mosaic results of all countries
    rst_mean_world <- do.call(raster::merge, list_rst_mean)
    # Export mosaic
    raster::writeRaster(rst_mean_world, file.path('..', 'results', filename_mean))
  }
}


library(shiny)
source('svm.r')

  server <- function(input, output){

    randomVals <- eventReactive(input$go, {
      runif(data[input$var1], data[input$var2])
    })

    output$keepAlive <- renderText({
      req(input$count)
      paste("keep alive ", input$count)
    })

    #Assign reactive variables
    var1<-reactive({input$var1})
    var2<-reactive({input$var2})

    #Output reactive variables
    output$selected_var1<- renderText({
      paste("You have selected", var1())
    })
    hr()
    output$selected_var2<- renderText({
      paste("You have selected", var2())
    })

    output$title<-renderText({
      paste("The correclation between", var1()," and ",var2())
    })

    output$img <- renderPlot({

        if(var1()!=var2()){
          var1<-data[input$var1]
          var2<-data[input$var2]
         # df<-data.frame(var1,var2)
          df<-data.frame(var1,var2)

          plot(df, col=c(28,32))
          #plot(randomVals())
          #polygon(df, col="red", border="blue")
        }else{

          shinyalert("Warning","Please select non-duplicate paramaters")}

  })
  }


rm(list=ls())
source('paths.r')

spatial.scale <- "core"
spatial.scale <- "plot"

# change output/input depending on our scale of interest
if (spatial.scale == "core") {
  output.path <-
    paste0(pecan_gen_16S_dir, "figures/NEON.core_calibration_density_tax.scale_ddirch_16S.png")
  # load fits
  pl <- readRDS(core.CV_NEON_dmulti.ddirch_16S.path)
} else if (spatial.scale == "plot") {
  #Set output path.----
  output.path <-
    paste0(pecan_gen_16S_dir, "figures/NEON.plot_calibration_density_tax.scale_ddirch_16S.png")
  # load fits
  pl <- readRDS(plot.CV_NEON_dmulti.ddirch_16S.path)
}

#phylogenetic and functional groups.
pl.r2 <- list()
lev.r2.out <- list()
for(i in 1:length(pl)){
  #if (p==1) lev <- pl[[i]]$
  lev <- pl[[i]]
  obs <- lev$observed
  pred <- lev$predicted
  lev.r2 <- list()
  for(j in 1:ncol(obs)){lev.r2[[j]] <- summary(lm(obs[,j] ~ pred[,j]))$r.squared}
  lev.r2 <- unlist(lev.r2)
  names(lev.r2) <- colnames(obs)
  lev.r2 <- lev.r2[names(lev.r2) != 'other' & names(lev.r2) !="1"]
  pl.r2[[i]] <- lev.r2
  names(pl.r2)[[i]] <- names(pl)[i]
}
all.r2 <- pl.r2
# if we do have functional groups
if (length(pl.r2) > 5) {
fg <- unname(pl.r2[6:17])
fg.r2.all <- list(unlist(fg))
names(fg.r2.all)<- "functional group"
all.r2 <- c(fg.r2.all, pl.r2[1:5])

# since theres no good fg here right now
all.r2 <- all.r2[2:6]
}

lev.mu <- unlist(lapply(all.r2, mean))
lev.sd <- unlist(lapply(all.r2, sd))
lev.N  <- unlist(lapply(all.r2, length))
lev.se <- lev.sd / sqrt(lev.N)
all.r2.unlist <- unlist(all.r2)
#names(lev.mu)[1] <- 'functional'

#Get truncated density so that we don't have densities less than zero.----
h <- density(all.r2.unlist)$bw  #get dansity bandwith
# Compute edge weights.
w <- 1 / pnorm(0, mean=all.r2.unlist, sd=h, lower.tail=FALSE)
#Generate truncated distribution.
h <- density(all.r2.unlist, bw=h, kernel="gaussian", weights=w / length(all.r2.unlist))
h$y[h$all.r2.unlist < 0] <- 0
#Check: the integral ought to be close to 1:
if(sum(h$y * diff(h$x)[1]) > 1.1 | sum(h$y * diff(h$x)[1]) < 0.9){
  warning('Zero-truncated density sum is not close to 1. Consider doing something else...')
}

#Make density plot.----
#png save settings.
png(filename=output.path,width=8,height=5,units='in',res=300)

#global plot settings.
trans <- 0.3 #shading transparency.
o.cex <- 1.3 #outer label size.
par(mfrow = c(1,2), mar = c(5.5,4.2,1.5,1.5))

#R2 density plot.
plot(h,xlim = c(0, 1), ylim = c(0, round(max(h$y), 0)), bty = 'n', xlab = NA, ylab = NA, main = NA, yaxs='i', xaxs = 'i', las = 1)
polygon(h, col = adjustcolor('purple',trans), border = NA)
mtext('Density', side = 2, line = 2.2, cex = o.cex)
mtext(expression(paste("Calibration R"^"2")), side = 1, line = 2.5, cex = o.cex)

# #calbiration R2 as a function of phylo/function scale.
x <- 1:length(lev.mu)
limy <- c(0,max(lev.mu + lev.se))
plot(lev.mu ~ x, cex = 2.5, ylim = limy, pch = 16, ylab = NA, xlab = NA, bty='n', xaxt = 'n', main=paste0(spatial.scale, "-level fit"))
#segments(x,lev.mu-lev.se,x,lev.mu+lev.se)
lines(x, lev.mu, lty = 2)
mtext(expression(paste("Calibration R"^"2")), side = 2, line = 2.2, cex = o.cex)
axis(1, labels = F)
text(x=x, y = -.04, labels= names(lev.mu), srt=45, adj=1, xpd=TRUE)

#end plot.
dev.off()


lea <- function(env, ped,env_file) {
    if (is.character(env))
        if (env != "max.dist" | env != "min.dist"){
            latentFactors = 5
        } else {
            latentFactors = 3
        }
        env <- toString(env) %>% gsub("[[:space:]]","",.)
        geno <- ped2geno(ped, output.file=paste0(env,".geno"), force=TRUE)
        lfmm <- ped2lfmm(ped, output.file=paste0(env,".lfmm"), force=TRUE)
        #geno <- vcf2geno(vcf, output.file=paste0(env,".geno"), force=TRUE)
        #lfmm <- vcf2lfmm(vcf, output.file=paste0(env,".lfmm"), force=TRUE)

        ################
        # Differentiation
        proj.snmf <- snmf(geno,K=latentFactors,entropy=T,ploidy=2,project="new",alpha=10,tolerance=0.0001,repetitions=2,iterations=100,CPU=25,percentage=.75)
        # fst values
        best <- which.min(cross.entropy(proj.snmf, K = latentFactors))
        fst.values <- fst(proj.snmf, K = latentFactors, run = best)
        # z-scores
        n <- dim(Q(proj.snmf, K = latentFactors, run = best))[1]
        fst.values[fst.values<0] <- 0.000001
        GD_z_scores <- sqrt(fst.values*(n - latentFactors)/(1 - fst.values))
        GD_z_scores <- as.data.frame(GD_z_scores)
        colnames(GD_z_scores) <- paste0(env,"_GD_zscores")
        #write.table(x=z.scores,file=paste0(env,"_GD_zscores.txt"),quote=F,row.names=F,col.names=paste0(env,"_z"))
        ################
        ################
        # Association
        proj.lfmm <- lfmm(lfmm, env_file, K = latentFactors, repetitions = 2, project = "new", iterations = 100, burnin = 50, CPU = 25, missing.data = TRUE, random.init = TRUE)
        # z-scores from all repititions
        zv <- data.frame(z.scores(proj.lfmm, K = latentFactors))
        zv %>% rowwise() %>% mutate("{env}_EA_zscores" := median(c_across(everything()))) %>% select(paste0(env,"_EA_zscores")) %>%
        cbind(.,GD_z_scores) %>%
        write.table(x=., file = paste0(env,"_zscores.txt"),quote=F,row.names=F,col.names=T,sep="\t")
        #################
}


library(shiny)
library(shinyjs)

chart_options <- c('Bar chart'='bc','Histogram'='h', 'No graph' = 'x')

graphs_list <-	c(
	'Sampled controls' = 'sci',
	'Pooled sampled controls' = 'scp',
	'All cases' = 'a',
	'NPCs' = 'npc',
	'NPCs (separate panels)' = 'npc_sep',
	'NPCs vs Signal' = 'npc_v_signal',
	'XY verification graphs'='xy',
	'Regression vs normalisation channel' = 'reg'
)

# Define UI for application that plots random distributions
shinyUI(tagList(useShinyjs(),navbarPage(
	title = 'Mitochondrial immunofluorescence analysis',
	tabPanel('Load',

		fluidRow(
			column(4,
				fileInput('file1', 'File',	accept = c(	'text/csv',	'text/comma-separated-values','text/tab-separated-values','text/plain','.csv','.tsv')),
				textInput('separator','Separator',value=' '),
				p('Choose a CSV file to upload. You can also break the filename by separator character(s)... leave the separator box blank to leave it as one field. You can just type a single space if required.')
			),
			column(4,
				selectInput('TypeCol', 'Type (OXPHOS/NPC)',c()),
				selectInput('SnapCol', 'Snap (usually Filename)',c())
			),
			column(4,
				selectInput('CaseCol', 'Subject IDs',c()),
				selectizeInput('Controls', 'Which Subject IDs are controls?',c(),multiple = T)
			)
		),

		fluidRow(
			column(1, p('Channel')),
			column(2, p('Label')),
			column(1, p('Use'))
		),

		uiOutput("choose_channels"),

		hr(),

		fluidRow(
			dataTableOutput("setup_table")
		),

		fluidRow(
			verbatimTextOutput("errors"),
			p('Info:'),
			verbatimTextOutput("info")
		)
	),

	tabPanel('Channels',
 	       fluidRow(
 	         column(1,strong("Assign channels")),
 	         column(2,selectInput('NormChan', 'Normalisation',c())),
            column(2,selectInput('XChan', 'X axis',c())),
            column(2,selectInput('YChan', 'Y axis',c())),
            column(2,selectInput('ColourChan', 'Colour',c())),
            column(2,selectInput('AreaChan', 'Area',c()))
    		  ),

    		  fluidRow(
    		    column(1,strong("Graph to display")),
    		    column(2,p()),
    		    column(2,selectInput('XGraph', '',chart_options,selected='bc')),
    		    column(2,selectInput('YGraph', '',chart_options,selected='bc')),
    		    column(2,selectInput('ColourGraph', '',chart_options,selected='h')),
    		    column(2,selectInput('AreaGraph', '',chart_options,selected='x'))
    		  ),

		fluidRow(
			column(2, p('Channel')),
			column(1, p('Remove background')),
			column(1, p('Ordered background')),
			column(1, p('Normalise')),
			column(1, p('Cutoffs')),
			column(3, p('Cutoff labels'))
		),

		uiOutput("setup_channels")
	),

	tabPanel('Check data',
 		fluidRow(
 		  column(3,selectInput('graph_type', 'Output to display', graphs_list)),
 		  column(2,selectInput('CheckChan', 'Channel',c()))
 		),
 		plotOutput("prep_plot",width = "800px"),
		p('Random sample data table'),
		dataTableOutput("prep_table"),
		p('Output data with z scores and categories'),
		dataTableOutput("prep_table1"),
		verbatimTextOutput("prep_err")
	),

	tabPanel('Output',
		fluidRow(
		  column(4,
		        fluidRow(
		          column(1,p()),
		          column(6,selectInput('output_caseno', 'Subject ID',c()))
	          ),
		        fluidRow(
		          column(5,actionButton('generateAll', 'Generate all')),
		            column(5,downloadButton('download_all', label = "Download all", class = NULL))
            ),
		        fluidRow(
        			column(5,downloadButton('download_this', label = "Download this", class = NULL)),
  			      column(5,downloadButton('download_data', label = "Download all data", class = NULL))
		        ),
		        fluidRow(
		          column(10,sliderInput("xrange", label = strong("x range"), min = -50, max = 10, value = c(-26,4)))
	          ),
		        fluidRow(
		          column(10,sliderInput("yrange", label = strong("y range"), min = -50, max = 10, value = c(-26,4)))
		        ),
		        fluidRow(verbatimTextOutput("test_out"))
		  ),
		  column(8, plotOutput("drgradientgraph",width = "600px", height="848px"))
		  )
	)
)))


library(plyr)
library(gdata)

getAvg <- function(tbl) {

}

movieFile='movie_titles.txt'

# Read in list of movies, movie's ratings,
# movies <- read.table(movieFile, header = FALSE, sep=",")
movies <- read.csv(movieFile) #, header = FALSE, sep=",")
colnames(movies) <- c("ID","Year","Title");

# ratingFile='mv_0000001.txt'
# rating <- read.csv(ratingFile, skip=1)
ratingNames<- c("User","Rating","Date");
# colnames(rating) <- ratingCol

print("Start")
setwd("training_set")
rfiles= list.files(pattern="mv_000000*")
mr = lapply(rfiles, read.csv, skip=1, col.names=ratingNames)

k <- function(vec) { colMeans(vec["Rating"]) }
netflixMean <- data.frame(unlist(lapply(mr,k)))

setwd("/home/users/scrasmussen/db-project/netflix/test")
print("Fin")


##CTE534_Sentinel2=group
##Directorio=string
##AOI=vector
##Sentinela20m=output raster
##showplots
#libraries
#install.packages("~/Dropbox/0_Paquetes/Sentinel2_1.0.tar.gz", repos=NULL, type="source")
library(Sentinel2)

#Definir directorio de trabajo
setwd(Directorio)
Imagen <- list.files(pattern = "L2A",
                     full.names = TRUE)
Sentinela <- readSentinel2(Imagen)

#Separar según resolución espacial
Sentinela20 <- Sentinela@TwentyRes
names(Sentinela20) <- c("B2_BLUE",
                        "B3_GREEN",
                        "B4_RED",
                        "B5_VNIR1",
                        "B6_VNIR2",
                        "B7_VNIR3",
                        "B8A_NIR2",
                        "B11_SWIR1",
                        "B12_SWIR2",
                        "SCL")

#Cortar cada brick
Sentinela20m <- crop(Sentinela20, AOI)
Sentinela20m

plot(Sentinela20m)


surfacearea.estimate = function( bcp, O ) {

  nms = O$plotdata[ O$bottom.contact,]

  if (! ( exists( "wingspread", nms) || exists( "doorspread", nms) ) ) {
    warning( "Wingspread and doorspread were not found" )
    return(NA)
  }

  nms$sm.wingspread = NA
  nms$sm.doorspread = NA

  nd = nrow(nms)
  if (0) {
    plot( doorspread ~ timestamp, nms )
    plot( wingspread ~ timestamp, nms )
    plot( wingspread ~ doorspread, nms, type="b" )
    plot( wingspread ~ depth, nms, type="l" )
    plot( doorspread ~ depth, nms, type="l" )
  }

  # estimate/predict missing data where possible:
  jj = which( is.na( nms$doorspread ) & !is.na( nms$wingspread) )
  if (length( jj ) > 0 ) {
    kd = lm( doorspread ~ wingspread, nms, na.action="na.omit" )
    if ( ! "try-error" %in% class( kd) ) nms$doorspread[ jj ] = predict( kd, nms[jj,] )
  }

  ii = which( is.na( nms$wingspread ) & !is.na( nms$doorspread) )
  if (length( ii) > 0 ) {
    kw = try (lm( wingspread ~ doorspread, nms, na.action="na.omit" ), silent=TRUE)
    if ( ! "try-error" %in% class( kw) ) nms$wingspread[ ii ] = predict( kw, nms[ii,] )
  }

  ## smooth and filter wingspread
  ii = which( is.finite( nms$wingspread ) )
  if (length(ii) > 10 ){

    nms$sm = interpolate.xy.robust( nms[, c("ts", "wingspread")], method="sequential.linear",
        trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
    nms$sm = interpolate.xy.robust( nms[, c("ts", "sm")], method="moving.window",
        trim=bcp$noisefilter.trim, target.r2=bcp$noisefilter.target.r2, mv.win=bcp$noisefilter.var.window )

    kk = nms$wingspread - nms$sm
    i = which.quantile ( kk, probs=bcp$noisefilter.quants, inside=FALSE )
    if (length(i) > 0) nms$wingspread [ i ] = NA

    # redo interpolation with filtered data removed
    test = NULL
    test = interpolate.xy.robust( nms[, c("ts", "wingspread")], method="sequential.linear",
      probs=bcp$noisefilter.quants, target.r2=bcp$noisefilter.target.r2, trim=bcp$noisefilter.trim )
    if ( "try-error" %in% class(test) ) {
      test = interpolate.xy.robust( nms[, c("ts", "wingspread")], method="moving.window",
        trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
    }
    nms$sm.wingspread = test
  }

    ### --- doorspread

  ii = which( is.finite( nms$doorspread ) )
  if (length(ii) > 10 ) {

    nms$sm = interpolate.xy.robust( nms[, c("ts", "doorspread")], method="sequential.linear" ,
        trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
    nms$sm = interpolate.xy.robust( nms[, c("ts", "sm")], method="moving.window",
        trim=bcp$noisefilter.trim, target.r2=bcp$noisefilter.target.r2, mv.win=bcp$noisefilter.var.window )

    kk = nms$doorspread - nms$sm
    i = which.quantile ( kk, probs=bcp$noisefilter.quants, inside=FALSE )
    if (length(i) > 0) nms$doorspread [ i ] = NA

    # redo interpolation with filtered data removed
    test =NULL
    test  = interpolate.xy.robust( nms[, c("ts", "doorspread")], method="sequential.linear",
        probs=bcp$noisefilter.quants, target.r2=bcp$noisefilter.target.r2, trim=bcp$noisefilter.trim )
    if ( "try-error" %in% class(test) ) {
      test = interpolate.xy.robust( nms[, c("ts", "doorspread")], method="moving.window" ,
        trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
    }

    nms$sm.doorspread = test
  }

    ## depths -- smooth and filter one last time

    # dh = NULL  # incremental distance horizonatal
    # dv = NULL  # incremental distance vertical
    # smooth again as there is occasionally v. high freq noise still in the depth data
    depth.smoothed = O$depth.smoothed [ O$bottom.contact ]
#    depth.smoothed = interpolate.xy.robust( cbind( nms$ts, depth.smoothed), method="moving.window",
#        target.r2=bcp$noisefilter.target.r2, trim=bcp$noisefilter.trim, mv.win=bcp$noisefilter.var.window )

    dv = c(0, abs( diff( depth.smoothed )) / 1000 ) # km  .. incremental difference in vertical distance
    dv = interpolate.xy.robust( cbind( nms$ts, dv), method="sequential.linear" ,
        trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
    dv = interpolate.xy.robust( cbind( nms$ts, dv), method="moving.window",
        target.r2=bcp$noisefilter.target.r2, trim=bcp$noisefilter.trim, mv.win=bcp$noisefilter.var.window )

    # determine the algorithm to use for use to determine tow distance
    coords =  c( "longitude", "latitude" )
    dh = rep(NA, nd)  # km.. incremental distance of  horizontal component
    npos = length( unique( paste( nms$longitude, nms$latitude) ) )
    if (npos > 30) {
      # good gps positioning in modern series
      # otherwise if poor spatial resolution: resort to using ship speeds and to estimate horizontal distance ..
      # this needs to be done at a project level so, here we set the SA estimates to NA and provide best dist vertical
      # and net spread data

      # sometimes GPS loses contact and GPS position stays static though still moving ..
      # elimiate zero/small values and interpolate where required
      H = geosphere::distGeo ( nms[ 1:(nd-1), coords ], nms[ 2:nd, coords ] ) / 1000 ## in meters .. convert to km

      oo = which( H < bcp$gps.distance.range.valid.km[1] | H > bcp$gps.distance.range.valid.km[2] )
      if (length( oo) > 1 ) {
        nms$longitude[oo] = NA
        nms$latitude [oo] = NA
        nms$longitude = interpolate.xy.robust( nms[, c("ts", "longitude") ], method="sequential.linear" ,
          trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
        nms$latitude = interpolate.xy.robust( nms[, c("ts", "latitude") ], method="sequential.linear" ,
          trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
        H = geosphere::distGeo ( nms[ 1:(nd-1), coords ], nms[ 2:nd, coords ] ) / 1000 ## in meters .. convert to km
      }

      # recheck
      pp = which( H < bcp$gps.distance.range.valid.km[1] | H > bcp$gps.distance.range.valid.km[2] )
      if (length( pp ) > 1 ) H[pp] = NA
      H = interpolate.xy.robust( cbind( nms$ts[1:(nd-1)], H), method="sequential.linear" ,
          trim=bcp$noisefilter.trim, probs=bcp$noisefilter.quants )
      H = interpolate.xy.robust( cbind( nms$ts[1:(nd-1)], H), method="moving.window",
          target.r2=bcp$noisefilter.target.r2, trim=bcp$noisefilter.trim, mv.win=bcp$noisefilter.var.window )
      dh = c( 0, H )
    }

    ## integration step
    dd = sqrt( dh^2 + dv^2)  ## total incremental distance, km (path length)
    sa.incremental.door = dd * ( nms$sm.doorspread / 1000 )  # km^2 (path length * path width)
    sa.ds = sum( abs( sa.incremental.door ) )

    sa.incremental.wing = dd * ( nms$sm.wingspread / 1000 )  # km^2
    sa.ws = sum( abs( sa.incremental.wing ) )

    out = list(
      distances.total = cumsum(dd) ,
      distances.vertical = cumsum(dv) ,
      distances.horizontal = cumsum(dh) ,
      door.sa.cum = cumsum( sa.incremental.door ),
      wing.sa.cum = cumsum( sa.incremental.wing ),
      door.sa=sa.ds,
      wing.sa=sa.ws,
      door.mean=mean(nms$sm.doorspread),
      wing.mean=mean(nms$sm.wingspread),
      door.sd=sd(nms$sm.doorspread),
      wing.sd=sd(nms$sm.wingspread),
      wing.smoothed=nms$sm.wingspread,
      door.smoothed=nms$sm.doorspread )

    return (out)

  }


#' This function loads data from API and performs functionality based on the data.
#' @description In this package, we connect to a web API and fetch data from API, a functionality is created where in user inputs Municipality Name and  party wise vote distribution is plotted. The same functionality is called in shiny app making it a reactive input output program.
#' @param Municipality_name Takes this as argument and party wise vote distribution is plotted.
#' @import ggplot2
#' @examples
#' \dontrun{
#' PartyVoteShare(Municipality_name = "Karlshamn")
#' }
#' @return Returns the plot with party wise vote distribution of the municipality user entered.
#' @export

#library(httr)
#library(ggplot2)
#library(shiny)
#library(readxl)

#function to plot results based on Municipality Name

MunicipalityResults <- function(Municipality_name){
  url <- "https://data.val.se/val/val2014/statistik/2014_riksdagsval_per_kommun.xls"
  httr::GET(url = url, httr::write_disk(tf <- tempfile(fileext = ".xls")))
  get_data_temp <- readxl::read_excel(tf, 1L, col_names = TRUE)
  get_data <- get_data_temp[-1,]
  colnames(get_data) <- c(get_data[1,])
  get_data <- get_data[-1,]
  get_data_df <- as.data.frame(get_data)
  get_data_df$LAN <- NULL
  get_data_df$KOM <- NULL
  colnames(get_data_df) <- c("County","Municipality","M","MPER","C","CPER","FP","FPPER","KD","KDPER","S","SPER","V","VPER","MP","MPPER","SD","SDPER","FI","FPPER","OVR","OVRPER","BL","BLPER","OGPER","OG")
  if( is.character(Municipality_name) & Municipality_name %in% get_data_df$Municipality ){

    get_req_row_data <- get_data_df[get_data_df$Municipality == Municipality_name, ]
    sub_df <- get_req_row_data[,-c(1,2,4,6,8,10,12,14,16,18,20,22,24,26,27,28,29,30,31)]
    t_sub_df <- t(sub_df)
    row.names(t_sub_df) <-c("M","C","FP","KD","S","V","MP","SD","FI","OVR","BL","OG")
    x_axis <- row.names(t_sub_df)
    y_axis <- as.vector(t_sub_df[,1])
    partynames <- c("M = Moderates","C = The Center Party","FP = The Liberal Party","KD = The Christian Democrats",
                    "S = Labor-Socialdemokraterna","V = The Left","MP = The environmental party the Greens","SD = Sweden Democrats",
                    "FI = Feminist Initiative","OVR = Other parties","BL = Invalid voices - blank","OG = Invalid votes - others")
    PartyNames <- vector()
    TotalVotes <- vector()
    fun1_df <- data.frame(PartyNames = x_axis, TotalVotes = y_axis  )
    p<-ggplot2::ggplot(data=fun1_df, ggplot2::aes(x=PartyNames, y=TotalVotes, fill=partynames)) +
      ggplot2::geom_bar(stat="identity") +
      ggplot2::geom_text(aes(label=TotalVotes), vjust=1.6, color="black", size=3.5) +
      ggplot2::theme_minimal() + ggplot2::labs(title = "Municipality Result")
    return(p)
  } else stop("Input arguments are not character type : Check your Input")
}

#MunicipalityResults(Municipality_name = "Karlshamn")


#####
#
# Exceedence curves by land use.
#
# This script called by Plot_byParam_ver9_Apr2014.r.
#
#####

require(NADA)

##### Plot K-M Curves: ###############################################################################################
K_M <- cenfit(obs=ParamData$new_Result_Value, censored=ParamData$nonDetect_Flag, groups=ParamData$Type)

  KM_data <- summary(K_M)

  for (iUse in c(1:length(KM_data))) {
     if (iUse == 1) {
       LandUse <- strsplit(names(KM_data[1]),"=")[[1]][2]
       plot_data_old <- cbind( KM_data[[1]], LandUse)
     } else {
       LandUse <- strsplit(names(KM_data[iUse]),"=")[[1]][2]
       plot_data_new <- cbind( KM_data[[iUse]], LandUse)
       plot_data <- rbind(plot_data_old, plot_data_new)
       plot_data_old <- plot_data
  }}

if (ncol(plot_data) > 3) {
  plot(x=1:10, y=1:10,
       xlim = c(0,1),
       ylim = ylimits,
       type = "n",
       xlab = "",
       ylab = ParamList[i],
       log  = "y",
       xaxs = "i",
       yaxs = "i",
       main = "\nEmpirical Distribution \nFunction (EDF)",
       las  = 2,
       cex.axis=0.8,
       xaxt = "n"
       )

  axis(side=1,
       at=c(0, 0.2, 0.4, 0.6, 0.8, 1),
       labels=c(0, 20, 40, 60, 80, 100)
       )
  mtext(text="Percent Below",
        side=1,
        at=0.5,
        line=2,
        cex=0.8
        )

  # set up parameters for the lines representing each land use
  landuseLines <- data.frame(
    lu  = c("IND", "COM", "HDR", "LDR"),
    col = c("orange", "black", "blue", "deeppink"),
    lty = c("dashed", "solid", "dotdash", "dotted")
    )

  # Plot each land use line individually
  for (j in 1:nrow(landuseLines)) {

    data <- which(as.character(plot_data$LandUse) == as.character(landuseLines[j,1]))
    lines(x = plot_data[data, "prob"],
          y = plot_data[data, "obs"],
          type = "s",
          lty  = as.character(landuseLines$lty[j]),
          col  = as.character(landuseLines$col[j]),
          lwd  = 1
          )
  }

  # Labels & legend
  ymax <- par("usr")[4]
  ymin <- par("usr")[3]
  ymin_legend <- 10^(ymax + 0.01*(ymax-ymin))
  ymax_legend <- 10^(ymax + 0.225*(ymax-ymin))

  legend(x = c(0.8,1.1),
         y = c(ymin_legend, ymax_legend),
         legend = c("Ind", "Com", "HRes", "LRes"),
         lty = c("dashed", "solid", "dotdash", "dotted"),
         col = c("orange", "black", "blue", "deeppink"),
         xpd = NA,
         cex = 0.8,
         bty = "o",
         bg  = "white"
         )
} else {
  plot(x = c(1:10),
       y = c(1:10),
       type = "n",
       xaxt = "n",
       yaxt = "n",
       xlab = "",
       ylab = "",
       bty  = "n"
       )

  text(x = 5, y=5, "Not Plotted\n(Too few detects)")

}


fun.divide.to.seg <- function(hapLength, by = 50){
#    return(floor(seq(1, hapLength, length.out =numSeg)))
    myseq = seq(1, hapLength, by = by)
    if ((hapLength-1)%%by != 0){
        myseq = c(myseq, hapLength)
    }
    return(myseq)
}

getIndex3 <- function (mixedSample, ref1, ref2, ref3, prop){
#1	1	2	2	3	3
#2	3	1	3	2	1
#3	2	3	1	1	2
#    prop = c(.25,.25,.5)
    prop = c(1,1,1)
    mySums = c ( sum(mixedSample[,1] != ref1)*prop[1] + sum(mixedSample[,2] != ref2)*prop[2] + sum(mixedSample[,3] != ref3)*prop[3] ,
                 sum(mixedSample[,1] != ref1)*prop[1] + sum(mixedSample[,3] != ref2)*prop[2] + sum(mixedSample[,2] != ref3)*prop[3] ,
                 sum(mixedSample[,2] != ref1)*prop[1] + sum(mixedSample[,1] != ref2)*prop[2] + sum(mixedSample[,3] != ref3)*prop[3] ,
                 sum(mixedSample[,2] != ref1)*prop[1] + sum(mixedSample[,3] != ref2)*prop[2] + sum(mixedSample[,1] != ref3)*prop[3] ,
                 sum(mixedSample[,3] != ref1)*prop[1] + sum(mixedSample[,2] != ref2)*prop[2] + sum(mixedSample[,1] != ref3)*prop[3] ,
                 sum(mixedSample[,3] != ref1)*prop[1] + sum(mixedSample[,1] != ref2)*prop[2] + sum(mixedSample[,2] != ref3)*prop[3] )
#print(mySums)
#print("")
    case = which.min(mySums)
    if ( case == 1 ){
        return (c(1,2,3))
    } else if ( case == 2 ){
        return (c(1,3,2))
    } else if ( case == 3 ){
        return (c(2,1,3))
    } else if ( case == 4 ){
        return (c(2,3,1))
    } else if ( case == 5 ){
        return (c(3,2,1))
    } else if ( case == 6 ){
        return (c(3,1,2))
    }
}

getIndex2 <- function (mixedSample, ref1, ref2){
    sum1 = sum(mixedSample[,1] != ref1) + sum(mixedSample[,2] != ref2)
    sum2 = sum(mixedSample[,2] != ref1) + sum(mixedSample[,1] != ref2)
    if ( sum1 < sum2 ){
        return (c(1,2))
    } else {
        return (c(2,1))
    }
}

exportSites <- function ( CHROM, POS, tmpIndex, logFileName){
    for ( index in tmpIndex ){
        cat ( as.character(CHROM[index]), ",", POS[index], "\n", file = logFileName, append = T)
    }
}

fun.computeErrors2 <- function(hap, ref1, ref2){
    switchError = c(0, 0)
    mutError = c(0, 0)

    haplength = dim(hap)[1]
    nhap = dim(hap)[2]

    if ( nhap == 2 ){

        index.of.seg = fun.divide.to.seg(haplength)
        countSwitch = matrix(NA, ncol = length(index.of.seg)-1, nrow = 2)

        for ( i in 1:(length(index.of.seg)-1) ){
            tmpIndex = c(index.of.seg[i]:(index.of.seg[i+1]-1))
            # k = 1
            if ( sum(hap[tmpIndex,1] != ref1[tmpIndex]) < sum(hap[tmpIndex,1] != ref2[tmpIndex]) ){
                hap[tmpIndex,1][hap[tmpIndex,1] != ref1[tmpIndex]] = 2
                hap[tmpIndex,1][hap[tmpIndex,1] == 0] = 5
                countSwitch[1,i] = 1
            } else {
                hap[tmpIndex,1][hap[tmpIndex,1] != ref2[tmpIndex]] = 2
                hap[tmpIndex,1][hap[tmpIndex,1] == 0] = 7
                countSwitch[1,i] = 2
            }
#            } else if ( sum(hap[tmpIndex,1] != ref3[tmpIndex]) <= sum(hap[tmpIndex,1] != ref2[tmpIndex]) ) {
#                hap[tmpIndex,1][hap[tmpIndex,1] != ref3[tmpIndex]] = 2
##                hap[tmpIndex,1][hap[tmpIndex,1] == 0] = 8
#                countSwitch[1,i] = 3
#            }

            # k = 2
            if ( sum(hap[tmpIndex,2] != ref2[tmpIndex]) < sum(hap[tmpIndex,2] != ref1[tmpIndex]) ){
                hap[tmpIndex,2][hap[tmpIndex,2] != ref2[tmpIndex]] = 2
                hap[tmpIndex,2][hap[tmpIndex,2] == 0] = 7
                countSwitch[2,i] = 2
            } else {
                hap[tmpIndex,2][hap[tmpIndex,2] != ref1[tmpIndex]] = 2
                hap[tmpIndex,2][hap[tmpIndex,2] == 0] = 5
#                hap[tmpIndex,2][hap[tmpIndex,2] == 0] = 8
                countSwitch[2,i] = 1
            }
#            } else if ( sum(hap[tmpIndex,2] != ref1[tmpIndex]) <= sum(hap[tmpIndex,2] != ref3[tmpIndex]) ) {
#                hap[tmpIndex,2][hap[tmpIndex,2] != ref1[tmpIndex]] = 2
#                hap[tmpIndex,2][hap[tmpIndex,2] == 0] = 5
#                countSwitch[2,i] = 1
#            }
        }
        strain = cbind(c(NA,NA), countSwitch)
        strainNext = cbind(countSwitch, c(NA,NA))
        switchError = rowSums(strain != strainNext, na.rm=T)
        mutError = colSums(hap==2)
    }

    return ( list ( hap = hap,
                    switchError = switchError,
                    mutError = mutError ))

}

fun.plotHapWithProp <- function( hap, prop, fig.title, max.at ){

    haplength = dim(hap)[1]
    nhap = dim(hap)[2]

    xrange = c(0, max.at)
    yrange = c(0, 1)
#    plot( xrange, yrange, type= "n", xlim=xrange, ylim = yrange, ylab="", main=fig.title, xlab = "", cex.lab = 2, cex.main = 4, cex.axis=2)
#    plot( xrange, yrange, type= "n", xlim=xrange, ylim = yrange, ylab="", main=fig.title, xlab = "", cex.lab = 2, cex.main = 3, cex.axis=2, xaxt="n")

    plot( xrange, yrange, type= "n", xlim=xrange, ylim = yrange, ylab="", main=fig.title, xlab = "", cex.lab = 2, cex.main = 1.4, cex.axis=2, xaxt="n")
    xleft = 0:(haplength-1)
    xright = xleft+1
#    ycum = as.numeric(c(0, prop[1], 1))
    ycum = as.numeric(c(0, cumsum(as.numeric(prop))))
#cat(ycum, "\n")

    for ( k in c(1:nhap) ){
      tmpHap = hap[,k]
      ybottom = ycum[k]
      ytop = ycum[k+1]
      rect(xleft, ybottom, xright, ytop, col = tmpHap , border = "transparent")
    }
    lab.at = c(1, 400, 800, 1200, 1600, 2000, 2369)
    axis(1, at=lab.at, labels=lab.at, las=1, lwd = 0, cex=2, cex.axis=2.4)

}

fun.computeErrors3 <- function(hap, ref1, ref2, ref3){
    switchError = c(0, 0, 0)
    mutError = c(0, 0, 0)

    haplength = dim(hap)[1]
    nhap = dim(hap)[2]

    if ( nhap == 3 ){
#        hap[hap[,1] != ref1, 1 ] = 2
#        hap[hap[,2] != ref2, 2 ] = 2
#        hap[hap[,3] != ref3, 3 ] = 2

        index.of.seg = fun.divide.to.seg(haplength)
        countSwitch = matrix(NA, ncol = length(index.of.seg)-1, nrow = 3)

        for ( i in 1:(length(index.of.seg)-1) ){
            tmpIndex = c(index.of.seg[i]:(index.of.seg[i+1]-1))
            # k = 1
            if ( sum(hap[tmpIndex,1] != ref1[tmpIndex]) < sum(hap[tmpIndex,1] != ref2[tmpIndex]) & sum(hap[tmpIndex,1] != ref1[tmpIndex]) < sum(hap[tmpIndex,1] != ref3[tmpIndex]) ){
                hap[tmpIndex,1][hap[tmpIndex,1] != ref1[tmpIndex]] = 2
                hap[tmpIndex,1][hap[tmpIndex,1] == 0] = 5
                hap[tmpIndex,1][hap[tmpIndex,1] == 1] = 5 # turn off the black color
                countSwitch[1,i] = 1
            } else if ( sum(hap[tmpIndex,1] != ref2[tmpIndex]) < sum(hap[tmpIndex,1] != ref3[tmpIndex]) ) {
                hap[tmpIndex,1][hap[tmpIndex,1] != ref2[tmpIndex]] = 2
                hap[tmpIndex,1][hap[tmpIndex,1] == 0] = 7
                hap[tmpIndex,1][hap[tmpIndex,1] == 1] = 7 # turn off the black color
                countSwitch[1,i] = 2
            } else if ( sum(hap[tmpIndex,1] != ref3[tmpIndex]) <= sum(hap[tmpIndex,1] != ref2[tmpIndex]) ) {
                hap[tmpIndex,1][hap[tmpIndex,1] != ref3[tmpIndex]] = 2
                hap[tmpIndex,1][hap[tmpIndex,1] == 1] = 0 # turn off the black color
                countSwitch[1,i] = 3
            }

            # k = 2
            if ( sum(hap[tmpIndex,2] != ref2[tmpIndex]) < sum(hap[tmpIndex,2] != ref1[tmpIndex]) & sum(hap[tmpIndex,2] != ref2[tmpIndex]) < sum(hap[tmpIndex,2] != ref3[tmpIndex]) ){
                hap[tmpIndex,2][hap[tmpIndex,2] != ref2[tmpIndex]] = 2
                hap[tmpIndex,2][hap[tmpIndex,2] == 0] = 7
                hap[tmpIndex,2][hap[tmpIndex,2] == 1] = 7 # turn off the black color
                countSwitch[2,i] = 2
            } else if ( sum(hap[tmpIndex,2] != ref3[tmpIndex]) < sum(hap[tmpIndex,2] != ref1[tmpIndex]) ) {
                hap[tmpIndex,2][hap[tmpIndex,2] != ref3[tmpIndex]] = 2
                hap[tmpIndex,2][hap[tmpIndex,2] == 1] = 0 # turn off the black color
                countSwitch[2,i] = 3
            } else if ( sum(hap[tmpIndex,2] != ref1[tmpIndex]) <= sum(hap[tmpIndex,2] != ref3[tmpIndex]) ) {
                hap[tmpIndex,2][hap[tmpIndex,2] != ref1[tmpIndex]] = 2
                hap[tmpIndex,2][hap[tmpIndex,2] == 0] = 5
                hap[tmpIndex,2][hap[tmpIndex,2] == 1] = 5 # turn off the black color
                countSwitch[2,i] = 1
            }

            # k = 3
            if ( sum(hap[tmpIndex,3] != ref3[tmpIndex]) < sum(hap[tmpIndex,3] != ref2[tmpIndex]) & sum(hap[tmpIndex,3] != ref3[tmpIndex]) < sum(hap[tmpIndex,3] != ref1[tmpIndex]) ){
                hap[tmpIndex,3][hap[tmpIndex,3] != ref3[tmpIndex]] = 2
                hap[tmpIndex,3][hap[tmpIndex,3] == 1] = 0 # turn off the black color
                countSwitch[3,i] = 3
            } else if ( sum(hap[tmpIndex,3] != ref2[tmpIndex]) < sum(hap[tmpIndex,3] != ref1[tmpIndex]) ) {
                hap[tmpIndex,3][hap[tmpIndex,3] != ref2[tmpIndex]] = 2
                hap[tmpIndex,3][hap[tmpIndex,3] == 0] = 7
                hap[tmpIndex,3][hap[tmpIndex,3] == 1] = 7 # turn off the black color
                countSwitch[3,i] = 2
            } else if ( sum(hap[tmpIndex,3] != ref1[tmpIndex]) <= sum(hap[tmpIndex,3] != ref2[tmpIndex]) ) {
                hap[tmpIndex,3][hap[tmpIndex,3] != ref1[tmpIndex]] = 2
                hap[tmpIndex,3][hap[tmpIndex,3] == 0] = 5
                hap[tmpIndex,3][hap[tmpIndex,3] == 1] = 5 # turn off the black color
                countSwitch[3,i] = 1
            }
        }
        strain = cbind(c(NA,NA,NA), countSwitch)
        strainNext = cbind(countSwitch, c(NA,NA,NA))
        switchError = rowSums(strain != strainNext, na.rm=T)
        mutError = colSums(hap==2)
    }

    return ( list ( hap = hap,
                    switchError = switchError,
                    mutError = mutError ))

}

measure.error.joe<-function(h.pair, h.pair.true, rel.cost.switch=2, do.plot=FALSE) {
    l <- ncol(h.pair);
    n.hap <- nrow(h.pair)
    possible.permn = combinat::permn(1:n.hap)
    n.permn = length(possible.permn)
    v<-rep(0, n.permn);
    vn<-v;

    tb<-array(0, c(n.permn, l));

    for ( j in 1:n.permn){
        v[j] = sum(h.pair[,1]!=h.pair.true[possible.permn[[j]],1]);
    }

    ee <- rep(0, n.permn)
    for (i in 2:l) {
        for ( j in 1:n.permn){
            ee[j] = sum(h.pair[,i]!=h.pair.true[possible.permn[[j]],i]);
            ones = rep(1, n.permn)
            ones[j] = 0
            tmp <- v + rel.cost.switch * ones
            vn[j] <- min(tmp) + ee[j]
            tb[j, i] <- which.min(tmp)
        }
        v<-vn;
    }

    #decode
    wm<-which.min(v);
    op<-array(0, c(1,l));
    n.s<-0;

    if (wm!=0){
        n.gt<-sum(h.pair[,l]!=h.pair.true[possible.permn[[wm]],l]);
    }

    op[l]<-wm;
    for (i in l:2) {
        wmp<-tb[wm,i];
        if (wmp!=wm) n.s<-n.s+1;

        if (wmp!=0){
            n.gt <- n.gt + sum(h.pair[,i-1] != h.pair.true[possible.permn[[wmp]],i-1]);
        }

        wm<-wmp;
        op[i-1]<-wm;
    }
	cat("\nDecoding gives:\nNo. switches:\t", n.s, "\nNo. GT errs:\t", n.gt, "\n\n");

	if (do.plot) {
        par(mfrow=c(2,1))
		plot(0,0,type="n", xlab="Position", ylab="", yaxt="n", xlim=c(0,ncol(h.pair)), bty="n", ylim=c(-0.5,1.5));
		image(x=1:ncol(h.pair), z=t(rbind(h.pair, rep(0, ncol(h.pair)), h.pair.true)), col=c("white", "black"),
			add=T);
		del<-which(diff(op[1,])!=0);
		if (length(del)>0) points(x=del, y=rep(0.5, length(del)), pch="|", col="red");

        for ( j in 1:n.hap ){
            wd1<-which(h.pair[j,] != h.pair.true[j,]);
    #
            if (length(wd1)>0) {
                points(x=wd1, y=rep(1.2, length(wd1)), pch=25, col=j+1, cex=0.5);
            }

        }
        image(t(op))
    }

#	return(c(n.s, n.gt));
        return (list(switchError = n.s,
                 mutError = n.gt,
                 op = op) )
}

measure.error.joe.2<-function(h.pair, h.pair.true, rel.cost.switch=2, do.plot=FALSE) {
    hapAndError = measure.error.joe(h.pair, h.pair.true, rel.cost.switch, do.plot)

    n.hap = nrow(h.pair)
#    cat("n.hap = ", n.hap, "\n")
    switchError = rep(0, n.hap)
    mutError = rep(0, n.hap)
    possible.permn = combinat::permn(1:n.hap)

    l = ncol(h.pair.true)
    hap = array(0, c(nrow(h.pair), l));
    for ( i in 1:l ){
        hap[,i] = possible.permn[[hapAndError$op[i]]]
    }

    for ( j in 1:n.hap ){
        switchError[j] = sum((hap[j,-l] - hap[j, -1]) != 0)
    }

    for ( i in 1:l ){
        hap[h.pair[,i] != h.pair.true[hap[,i],i], i ] = 0
    }

    for ( j in 1:n.hap ){
        mutError[j] = sum(hap[j,] == 0)
    }

    return ( list ( hap = t(hap),
                    switchError = switchError,
                    mutError = mutError ))

}

measure.error.joe.with.drop<-function(h.pair, h.pair.true, rel.cost.switch=2, rel.cost.drop = 1, do.plot=FALSE) {
    l <- ncol(h.pair);
    n.hap <- nrow(h.pair)
    possible.permn = combinat::permn(1:n.hap)
    current.len = length(possible.permn)

possible.permn[[7]] = c(1,2,1)
possible.permn[[8]] = c(1,1,2)
possible.permn[[9]] = c(2,1,1)

possible.permn[[10]] = c(1,3,1)
possible.permn[[11]] = c(1,1,3)
possible.permn[[12]] = c(3,1,1)

possible.permn[[13]] = c(2,3,2)
possible.permn[[14]] = c(2,2,3)
possible.permn[[15]] = c(3,2,2)

possible.permn[[16]] = c(2,1,2)
possible.permn[[17]] = c(2,2,1)
possible.permn[[18]] = c(1,2,2)

possible.permn[[19]] = c(3,1,3)
possible.permn[[20]] = c(3,3,1)
possible.permn[[21]] = c(1,3,3)

possible.permn[[22]] = c(3,2,3)
possible.permn[[23]] = c(3,3,2)
possible.permn[[24]] = c(2,3,3)

    n.permn = length(possible.permn)
print(n.permn)
    v<-rep(0, n.permn);
    vn<-v;

    tb<-array(0, c(n.permn, l));

    for ( j in 1:n.permn){
        v[j] = sum(h.pair[,1]!=h.pair.true[possible.permn[[j]],1]);
    }

    ee <- rep(0, n.permn)
    for (i in 2:l) {
        for ( j in 1:n.permn){
            ee[j] = sum(h.pair[,i]!=h.pair.true[possible.permn[[j]],i]);
            ones = rep(1, n.permn)
            ones[j] = 0
            drop.ones = rep(1, n.permn)
            drop.ones[j] = 0
            if (j<7){
                drop.ones[1:6] = 0
            } else {
                drop.ones[7:24] = 0
            }
            tmp <- v + rel.cost.switch * ones + rel.cost.drop*drop.ones
            vn[j] <- min(tmp) + ee[j]
            tb[j, i] <- which.min(tmp)
        }
        v<-vn;
    }

    #decode
    wm<-which.min(v);
    op<-array(0, c(1,l));
    n.s<-0;

    if (wm!=0){
        n.gt<-sum(h.pair[,l]!=h.pair.true[possible.permn[[wm]],l]);
    }

    op[l]<-wm;
    for (i in l:2) {
        wmp<-tb[wm,i];
        if (wmp!=wm) n.s<-n.s+1;

        if (wmp!=0){
            n.gt <- n.gt + sum(h.pair[,i-1] != h.pair.true[possible.permn[[wmp]],i-1]);
        }

        wm<-wmp;
        op[i-1]<-wm;
    }

	if (do.plot) {
        par(mfrow=c(2,1))
		plot(0,0,type="n", xlab="Position", ylab="", yaxt="n", xlim=c(0,ncol(h.pair)), bty="n", ylim=c(-0.5,1.5));
		image(x=1:ncol(h.pair), z=t(rbind(h.pair, rep(0, ncol(h.pair)), h.pair.true)), col=c("white", "black"),
			add=T);
		del<-which(diff(op[1,])!=0);
		if (length(del)>0) points(x=del, y=rep(0.5, length(del)), pch="|", col="red");

        for ( j in 1:n.hap ){
            wd1<-which(h.pair[j,] != h.pair.true[j,]);
    #
            if (length(wd1)>0) {
                points(x=wd1, y=rep(1.2, length(wd1)), pch=25, col=j+1, cex=0.5);
            }

        }
        image(t(op))
    }

    k.eff.permn = rep(0, n.permn)
    for (j in 1:n.permn){
        k.eff.permn[j] = length(unique(possible.permn[[j]]))
    }
    k.eff = k.eff.permn[op]

    drop.strain.permn = rep(0, n.permn)
    for (j in 1:n.permn){
        dropped = which(!c(1,2,3) %in% possible.permn[[j]])
        if ( length(dropped) > 0 ){
            drop.strain.permn[j] = dropped
        }
    }
    drop.strain =  drop.strain.permn[op]

    dropTimes = sum(diff(drop.strain) != 0)
    dropError = sum(drop.strain != 0)
    cat("\nDecoding gives:\nNo. switches:\t", n.s-dropTimes, "\nNo. GT errs:\t", n.gt, "\nNo. Drop errs:\t", dropError,"\n");
        return (list(switchError = n.s - dropTimes,
                 mutError = n.gt,
                 dropError = dropError,
                 op = op, drop.strain = drop.strain,
                 possible.permn = possible.permn) )
}

measure.error.joe.with.drop.2strain <-function(h.pair, h.pair.true, rel.cost.switch=2, do.plot=FALSE) {
    l <- ncol(h.pair);
    n.hap <- nrow(h.pair)
    possible.permn = combinat::permn(1:n.hap)

possible.permn[[3]] = c(1,1)
possible.permn[[4]] = c(2,2)

#possible.permn = list()
#possible.permn[[1]] = c(1,1)
#possible.permn[[2]] = c(2,2)
#possible.permn[[3]] = c(1,2)
#possible.permn[[4]] = c(2,1)

    n.permn = length(possible.permn)
    v<-rep(0, n.permn);
    vn<-v;

    tb<-array(0, c(n.permn, l));

    for ( j in 1:n.permn){
        v[j] = sum(h.pair[,1]!=h.pair.true[possible.permn[[j]],1]);
    }

#rel.cost.drop.current = 0
    ee <- rep(0, n.permn)
    same.path <- rep(0, n.permn)

    for (i in 2:l) {
#        rel.cost.drop.current = rel.cost.drop.current + 1
        for ( j in 1:n.permn){
            ee[j] = sum(h.pair[,i]!=h.pair.true[possible.permn[[j]],i]);

            ones = rep(1, n.permn)
            ones[j] = 0
            drop.ones = rep(1, n.permn)
            drop.ones[j] = 0
            if (j<3){
                drop.ones[1:2] = 0
            } else {
                drop.ones[3:4] = 0
            }
#            tmp <- v + rel.cost.switch * ones
            tmp <- v + rel.cost.switch * ones + same.path *drop.ones

            vn[j] <- min(tmp) + ee[j]
            transit.to = which.min(tmp)

            if ( j == transit.to ){
                same.path = same.path + 1
            } else {
                same.path = 0
            }

            tb[j, i] <- transit.to
        }

#        if ( rel.cost.drop.current > rel.cost.drop){
#            rel.cost.drop.current = 0
#        }
        v<-vn;
#        cat ("site ", i, " cost: ", v,"\n")
    }

    #decode
    wm<-which.min(v);
    op<-array(0, c(1,l));
    n.s<-0;

    if (wm!=0){
        n.gt<-sum(h.pair[,l]!=h.pair.true[possible.permn[[wm]],l]);
    }

    op[l]<-wm;
    for (i in l:2) {
        wmp<-tb[wm,i];
        if (wmp!=wm) n.s<-n.s+1;

        if (wmp!=0){
            n.gt <- n.gt + sum(h.pair[,i-1] != h.pair.true[possible.permn[[wmp]],i-1]);
        }

        wm<-wmp;
        op[i-1]<-wm;
    }

    k.eff.permn = rep(0, n.permn)
    for (j in 1:n.permn){
        k.eff.permn[j] = length(unique(possible.permn[[j]]))
    }
    k.eff = k.eff.permn[op]

    changed.permn.at = which(diff(op[1,]) != 0)
    changed.k.eff.at = which(diff(k.eff) != 0)

#print("changed.permn.at")
#print(changed.permn.at)
#print("changed.k.eff.at")
#print(changed.k.eff.at)

    drop.strain.permn = rep(0, n.permn)
    for (j in 1:n.permn){
        dropped = which(!c(1,2) %in% possible.permn[[j]])
        if ( length(dropped) > 0 ){
            drop.strain.permn[j] = dropped
        }
    }
    drop.strain =  drop.strain.permn[op]

#    definite.switch = sum(!changed.permn.at %in% changed.k.eff.at)
    dropTimes = sum(diff(drop.strain) != 0) #length(changed.k.eff.at)
    dropError = sum(drop.strain != 0)
    cat("\nDecoding gives:\nNo. switches:\t", n.s - dropTimes, "\nNo. GT errs:\t", n.gt, "\nNo. Drop switches", dropTimes, "\nNo. Drop errs:\t", dropError,"\n");

    hap.pair.true.idx = array(unlist(possible.permn[op]), c(2, length(op)))
    genotype.error = rep(0, n.hap)
    switch.error = rep(0, n.hap)
    drop.error = rep(0, n.hap)
    for ( j in 1:n.hap ){
        wd1 = c()
        for ( i in 1:l ){
            if ( h.pair[j,i] != h.pair.true[hap.pair.true.idx[j,i],i] ){
                wd1 = c(wd1, i)
            }
        }
        genotype.error[j] = length(wd1)
    }

    switch.error[1] = (sum(diff(hap.pair.true.idx[1,])!=0))
    switch.error[2] = (sum(diff(hap.pair.true.idx[2,])!=0))
    drop.error[1] = (sum(drop.strain == 1))
    drop.error[2] = (sum(drop.strain == 2))

	if (do.plot) {
#        par(mfrow=c(2,1))
        layout(matrix(c(1,1,1,1,2,2), 3, 2, byrow = T))
		plot(0,0,type="n", xlab="Position", ylab="", yaxt="n", xlim=c(0,ncol(h.pair)), bty="n", ylim=c(-0.5,1.5));
		image(x=1:ncol(h.pair), z=t(rbind(h.pair, rep(0, ncol(h.pair)), h.pair.true)), col=c("white", "black"),
			add=T);
		del<-which(diff(op[1,])!=0);
		if (length(del)>0) {points(x=del, y=rep(0.5, length(del)), pch="|", col="red");}

        for ( j in 1:n.hap ){
            wd1 = c()
            for ( i in 1:l ){
                if ( h.pair[j,i] != h.pair.true[hap.pair.true.idx[j,i],i] ){
                    wd1 = c(wd1, i)
                }
            }

            if (length(wd1)>0) {
                points(x=wd1, y=rep(1.2, length(wd1)), pch=25, col=j+1, cex=0.5);
#                print(length(wd1))
            }

        }
		plot(0,0,type="n", xlab="Position", ylab="", yaxt="n", xlim=c(0,ncol(h.pair)), bty="n", ylim=c(-0.5,1.5));
#        image(x=1:ncol(h.pair), z = t(rbind(op, array(drop.strain,c(1,l)))), col = heat.colors(4), add=T)
        image(x=1:ncol(h.pair), z = t(op), col = heat.colors(4), add=T)
    }

        return (list(switchError = n.s - dropTimes,
                 mutError = n.gt,
                 dropError = dropError,
                 op = op, drop.strain = drop.strain,
                 possible.permn = possible.permn, tb = tb,
                 switch.error = switch.error,
                 drop.error = drop.error,
                 genotype.error = genotype.error )
                 )
}

measure.error.joe.with.drop.2strain.2<-function(h.pair, h.pair.true, rel.cost.switch=2, do.plot=FALSE) {
    hapAndError = measure.error.joe.with.drop.2strain(h.pair, h.pair.true, rel.cost.switch, do.plot)

    n.hap = nrow(h.pair)
#    cat("n.hap = ", n.hap, "\n")
    switchError = rep(0, n.hap)
    mutError = rep(0, n.hap)
    dropTimes = rep(0, n.hap)
    dropError = rep(0, n.hap)

#print(hapAndError$possible.permn)
    l = ncol(h.pair.true)
    hap = array(0, c(nrow(h.pair), l));
    for ( i in 1:l ){
        hap[,i] = hapAndError$possible.permn[[hapAndError$op[i]]]
    }
#        print(hapAndError$drop.strain)
     for ( j in 1:n.hap ){
       dropTimes[j] = sum(diff(hapAndError$drop.strain == j) != 0)
    }

#    for ( j in 1:n.hap ){
#        switchError[j] = sum(diff(hapAndError$op[1,]) != 0) - sum(dropTimes)
#        if (switchError[j] < 0) switchError[j] = 0
#    }

    for ( j in 1:n.hap ){
        switchError[j] = sum(diff(hap[j,]) != 0) - dropTimes[j]
        if (switchError[j] < 0) switchError[j] = 0
    }

    for ( j in 1:n.hap ){
        dropError[j] = sum(hapAndError$drop.strain == j)
    }

    for ( i in 1:l ){
        hap[h.pair[,i] != h.pair.true[hap[,i],i], i ] = 0
    }

    for ( j in 1:n.hap ){
        mutError[j] = sum(hap[j,] == 0)
    }

    cat("switchError ", switchError, "\n")
    cat("mutError ", mutError,"\n")
    cat("dropError ", dropError,"\n")

    return ( list ( hap = t(hap),
                    switchError = switchError,
                    mutError = mutError,
                    dropError = dropError ))

}