dev<-"print"
dev<-"screen"
nox<-4; noy<-4;
paper<-FALSE        # graphics on paper=file (TRUE) or on screen (FALSE)
run.ID<-'B'         # file id used for paper output
cleanup()

first.year.on.plot<-1977
last.year.on.plot<-2030

incl.sp<-seq(1,14)  # species number to be included

#do.plot.other<-function(sp.plot=c(1),incl.prob=FALSE,incl.closure=FALSE,incl.0.group.M2=FALSE) {
#########################################
cleanup()
i<-0
oth<-Read.other.predator()
oth<-subset(oth,Year>=first.year.on.plot&Year<=last.year.on.plot)
oth<-tapply(oth$Other.bio/1000,list(oth$Species.n,oth$Year,oth$Quarter),sum)
y<-as.numeric(unlist(dimnames(oth)[2]))
q<-as.numeric(unlist(dimnames(oth)[3]))
for (sp in (incl.sp)) {
  if ((i %% (nox*noy-1))==0) {
    newplot(dev,nox,noy,Portrait=TRUE);
    par(mar=c(3,5,3,2))
  }
  i<<-i+1
  plot(y,oth[sp,,1],ylab='biomass',main=name[sp+1],ylim=c(0,max(oth[sp,,])),col=1,type='l')
  for (qq in (q)) lines(y,oth[sp,,qq],col=qq)
}


 F01CKJ Example Program Results

 Matrix A
      5.0    8.0
      8.0   14.0


source("common.r")

# Preprocess data and save interarrival times, processing time distributions, and vector size distributions.

####################################
## Preprocessing / Sanity Checks. ##
####################################

clockDuration <- 1 / 3393e6

dataDir <- "../data/"
dataFolders <- dir(dataDir)
dataFolders <- paste(dataDir, "/", dataFolders[grepl("exp", dataFolders)], "/", sep = "")

allData <- data.table()

progbar <- txtProgressBar(style = 3)

for (ii in 1:length(dataFolders)) {

    curFileList <- dir(dataFolders[ii])
    curFileList <- curFileList[grepl("clock.*dat", curFileList)]

    setTxtProgressBar(progbar, ii / length(dataFolders))

    parts.folder <-
        dataFolders[ii] %>%
        str_split("/") %>%
        unlist() %>%
        nth(length(.) - 1) %>%
        str_split("-|_") %>%
        unlist()

    # => beta
    currentMaxFrameSize <- parts.folder[3] %>% as.numeric()
    # => pktsize
    currentPacketSize <- parts.folder[5] %>% as.numeric()
    # => L
    currentQueueSize <- parts.folder[7] %>% as.numeric()

    for (jj in 1:length(curFileList)) {

        parts <- str_match(
            curFileList[jj],
            "clock-([[:alnum:]]+)-([[:digit:]]+)\\.dat")

        currentRate <- parts[3] %>% as.numeric()
        currentExpType <- parts[2]
        currentRepetition <- 1

        currentFilePath <- paste(dataFolders[ii], curFileList[jj], sep = "")

        currentData <- fread(currentFilePath,
                             select = c(4, 6, 8, 12),
                             col.names = c("t1", "vecsize", "t2", "t3")) %>%
            mutate(rate = currentRate,
                   rep = currentRepetition,
                   exptype = currentExpType,
                   maxfs = currentMaxFrameSize,
                   pktsize = currentPacketSize,
                   qsize = currentQueueSize,
                   t1 = as.integer64(t1),
                   t2 = as.integer64(t2),
                   t3 = as.integer64(t3)) %>%
            mutate(proctime = as.double(t3 - t1),
                   proctime2 = as.double(t3 - t2)) %>%
            filter(proctime > 0, vecsize <= currentMaxFrameSize) %>%
            # dt1 / dt3 correspond more closely to the paper's / model's definition of B since it's the
            # time between consecutive embeddings.
            mutate(dt1 = t1 - lag(t1, 1),
                   dt3 = t3 - lag(t3, 1),
                   pt1 = lead(t1, 1) - t1) %>%
            # FIXME: lead / lag issues with integer64 at margins..
            filter(dt1 > 0, dt3 > 0, pt1 < 600000, pt1 > 0)

        allData <- rbind(allData, currentData)

    }
}

allData <-
    allData %>%
    mutate(
        exptype = factor(exptype),
        maxfs = factor(maxfs),
        rep = factor(rep),
        ratef = factor(rate))

configs <-
    allData %>%
    group_by(exptype, pktsize, maxfs, qsize) %>%
    summarise(n = n()) %>%
    mutate(maxfs = as.numeric(as.character(maxfs)))

############################################################################
## Create linear fits for the batch service times for all configurations. ##
############################################################################

progbar <- txtProgressBar(style = 3)

for (ii in 1:nrow(configs)) {

    setTxtProgressBar(progbar, ii / nrow(configs))

    ## Get data, filter outliers.
    curData <- allData %>%
        filter(
            exptype == configs[ii, ]$exptype,
            pktsize == configs[ii, ]$pktsize,
            maxfs == configs[ii, ]$maxfs,
            qsize == configs[ii, ]$qsize) %>%
        mutate(clocks = as.double(pt1))

    curData.filtered <- data.frame()

    curData$isOutlier <- 0

    # Outlier detection per rate.
    for (kk in seq(500, 10e3, 500)) {

        winsize <- 100

        curSlice <- curData %>%
            filter(rate == kk)

        medbs <- median(curSlice$vecsize)

        for (jj in 1:floor(nrow(curSlice) / 100)) {
            currange <- (((jj-1)*winsize)+1) : (jj * winsize)
            curmean <- mean(curSlice$vecsize[currange])
            # if (curmean > medbs * 1.1) {
            # Second condition to avoid being too strict at low rates.
            if (curmean > medbs * 1.1 && abs(curmean - medbs) > 1) {
                curSlice$isOutlier[currange] <- 1
            }
        }

        curData.filtered <- rbind(curData.filtered, curSlice)

        cat(sprintf("rate %d, outlier ratio: %f\n", kk, nrow(curSlice %>% filter(isOutlier == 1)) / nrow(curSlice)))

    }

    nrow(curData.filtered %>% filter(isOutlier == 1)) / nrow(curData.filtered)

    curData.filtered <- curData.filtered %>%
        filter(isOutlier == 0)

    # Outlier detection done, export stats

    exportBatchSizeDependentMeanProcessingTime(
        curData.filtered,
        mark = F,
        beta = configs[ii, ]$maxfs,
        theFun = median,
        filename =
            sprintf("stats/medianE8_filtered_moon_nosleep_all_%s_pktsize_%d_beta_%d_L_%d.csv",
                    configs[ii, ]$exptype,
                    configs[ii, ]$pktsize,
                    configs[ii, ]$maxfs,
                    configs[ii, ]$qsize))

}


###############################################################################
# OVERVIEW:
# Code to combine Medicaid-Medicare & Public housing data to create two tables
# Public housing includes King County Housing Authority and Seattle Housing Authority data
# elig_demo: contains time invariant data. Should be 1 row per unique individual.
# elig_timevar: contains time varying data. Multiple rows per unique individual.
#
# STEPS:
# 01 - Process raw KCHA data and load to SQL database
# 02 - Process raw SHA data and load to SQL database
# 03 - Bring in individual PHA datasets and combine into a single file
# 04 - Deduplicate data and tidy up via matching process
# 05 - Recode race and other demographics
# 06 - Clean up addresses
# 06a - Geocode addresses
# 07 - Consolidate data rows
# 08 - Add in final data elements and set up analyses
# 09 - Join with Medicaid-Medicare eligibility & time varying data ### (THIS CODE) ###
# 10 - Set up joint housing/Medicaid analyses
#
# Alastair Matheson (PHSKC-APDE) | Danny Colombara (PHSKC-APDE)
# alastair.matheson@kingcounty.gov | dcolombara@kingcounty.gov
# 2016-08-13, split into separate files 2017-10, rewritten
# 2019-11-07, rewritten to created normalized mcaid_mcare_pha elig_demo & elig_timevar
#
###############################################################################

##### !!!URGENT!!! Make sure the underlying data is up to date! #####
  # Ensure the master cross-walk table linking Medicaid, Medicare, and Public housing IDs is up to date
  # - code 1: https://github.com/PHSKC-APDE/claims_data/blob/master/claims_db/phclaims/stage/tables/load_stage.xwalk_apde_mcaid_mcare_pha.r
  # - code 2: https://github.com/PHSKC-APDE/claims_data/blob/master/claims_db/phclaims/final/tables/load_final.xwalk_apde_mcaid_mcare_pha.sql
  # - SQL: [PHClaims].[final].[xwalk_apde_mcaid_mcare_pha]

  # Ensure the joint Medicaid-Medicare elig_demo table is up to date
  # - code 1: https://github.com/PHSKC-APDE/claims_data/blob/master/claims_db/phclaims/stage/tables/load_stage.mcaid_mcare_elig_demo.R
  # - code 2: https://github.com/PHSKC-APDE/claims_data/blob/master/claims_db/phclaims/final/tables/load_final.mcaid_mcare_elig_demo.sql
  # - SQL: [PHClaims].[final].[mcaid_mcare_elig_demo]

  # Ensure the joing Medicaid-Medicare elig_timevar table is up to date
  # - code 1: https://github.com/PHSKC-APDE/claims_data/blob/master/claims_db/phclaims/stage/tables/load_stage.mcaid_mcare_elig_timevar.R
  # - code 2: https://github.com/PHSKC-APDE/claims_data/blob/master/claims_db/phclaims/final/tables/load_final.mcaid_mcare_elig_timevar.sql
  # - SQL: [PHClaims].[final].[mcaid_mcare_elig_timevar]

##### Set up global parameter and call in libraries #####
options(max.print = 350, tibble.print_max = 30, scipen = 999)

library(odbc) # Used to connect to SQL server
library(glue) # Used to put together SQL queries
library(lubridate) # Used to manipulate dates
library(tidyverse) # Used to manipulate data
library(data.table) # Used to manipulate data

kc.zips.url <- "https://raw.githubusercontent.com/PHSKC-APDE/reference-data/master/spatial_data/zip_admin.csv"

yaml.elig <- "https://raw.githubusercontent.com/PHSKC-APDE/Housing/master/processing/09_mcaid_mcare_pha_elig_demo.yaml"

yaml.timevar <- "https://raw.githubusercontent.com/PHSKC-APDE/Housing/master/processing/09_mcaid_mcare_pha_elig_timevar.yaml"

source("https://raw.githubusercontent.com/PHSKC-APDE/claims_data/master/claims_db/db_loader/scripts_general/alter_schema.R")
source("https://raw.githubusercontent.com/PHSKC-APDE/claims_data/master/claims_db/db_loader/scripts_general/add_index.R")

##### Load data from SQL #####
### Public Housing ----
# use stage schema for now but switch to final once QA approach is sorted
db_apde51 <- dbConnect(odbc(), "PH_APDEStore51")
pha <- setDT(odbc::dbGetQuery(db_apde51, "SELECT
        pid, start_housing, startdate, enddate, dob_m6,
        gender_new_m6,
        race_new, r_aian_new, r_asian_new, r_black_new, r_nhpi_new, r_white_new, r_hisp_new,
        unit_add_new, unit_apt, unit_apt2, unit_city_new, unit_state_new, unit_zip_new,
        geo_hash_clean, geo_hash_geocode,
        agency_new, operator_type, portfolio_final, subsidy_type, vouch_type_final
                                FROM [PH_APDEStore].[stage].[pha] WHERE enddate >= '2012-01-01'"))

  ### Medicaid-Medicare-Public Housing ID crosswalk ----
  db_claims51 <- dbConnect(odbc(), "PHClaims51")
  xwalk <- setDT(odbc::dbGetQuery(db_claims51, "SELECT id_apde, pid FROM [PHClaims].[final].[xwalk_apde_mcaid_mcare_pha]"))

  ### Joint Medicaid-Medicare elig_demo ----
  elig.mm <- setDT(odbc::dbGetQuery(db_claims51, "SELECT * FROM [PHClaims].[final].[mcaid_mcare_elig_demo]"))
  elig.mm[, c("last_run") := NULL]

  ### Joint Medicaid-Medicare elig_timevar ----
  timevar.mm <- setDT(odbc::dbGetQuery(db_claims51, "SELECT * FROM [PHClaims].[final].[mcaid_mcare_elig_timevar]"))
  timevar.mm[, c("contiguous", "last_run", "cov_time_day") := NULL]

  ### Geo ref table ----
  ref.geo <- setDT(odbc::dbGetQuery(db_claims51, "
  SELECT geo_add1_clean, geo_city_clean, geo_state_clean, geo_zip_clean, geo_hash_geocode,
  geo_zip_centroid, geo_street_centroid, geo_countyfp10 AS geo_county_code,
  geo_tractce10 AS geo_tract_code, geo_hra_id AS geo_hra_code,
  geo_school_geoid10 AS geo_school_code
  FROM ref.address_geocode"))

##### Clean / prep mm data -----
  # fix dates
  elig.mm[, dob := as.Date(dob)]
  timevar.mm[, `:=` (from_date = as.Date(from_date), to_date = as.Date(to_date))]

##### Clean / prep housing data -----
# merge on id_apde
pha <- merge(pha, xwalk, by = "pid", all.x = TRUE, all.y = FALSE)
pha[, pid := NULL]
rm(xwalk)

# fix dates
date.vars <- c("start_housing", "from_date", "to_date", "dob")
setnames(pha, c("start_housing", "startdate", "enddate", "dob_m6"), date.vars)
pha[, c(date.vars) := lapply(.SD, as.Date), .SDcols = date.vars]
rm(date.vars)

# normalize gender
pha[gender_new_m6 == 1, gender_me := "Female"]
pha[gender_new_m6 == 2, gender_me := "Male"]
pha[, gender_female := 0][gender_me == "Female", gender_female := 1]
pha[, gender_male := 0][gender_me == "Male", gender_male := 1]
pha[, gender_new_m6 := NULL]

# identify most recent gender
setorder(pha, id_apde, -from_date) # sort to identify the most recent time per id
pha[, counter := 1:.N, by = c("id_apde")]
gender.recent <- pha[counter == 1, .(id_apde, gender_recent = gender_me)] # keep most recent gender
pha <- merge(pha, gender.recent, by = "id_apde", all.x = T, all.y = T)
pha[, counter := NULL]
rm(gender.recent)

# prep race
pha[, race_me := as.character(factor(race_new,
                                        levels = c("AIAN only", "Asian only", "Black only", "Multiple race", "NHPI only", "White only", ""),
                                        labels = c("AI/AN", "Asian", "Black", "Multiple", "NH/PI", "White", "Unknown")))]
pha[, race_new := NULL]

pha[, race_eth_me := race_me]
pha[r_hisp_new == 1, race_eth_me := "Latino"]

setnames(pha,
         c("r_aian_new", "r_asian_new", "r_black_new", "r_nhpi_new", "r_white_new", "r_hisp_new"),
         c("race_aian", "race_asian", "race_black", "race_nhpi", "race_white", "race_latino") )

# identify most recent race
setorder(pha, id_apde, -from_date) # sort to identify the most recent time per id
pha[, counter := 1:.N, by = c("id_apde")]
race.recent <- pha[counter == 1, .(id_apde, race_recent=race_me, race_eth_recent=race_eth_me)] # keep most recent race
pha <- merge(pha, race.recent, by = "id_apde", all.x = T, all.y = T)
pha[, counter := NULL]
rm(race.recent)

# add in geo_ data
pha <- merge(pha, ref.geo,
             by.x = c("unit_add_new", "unit_city_new", "unit_state_new", "unit_zip_new"),
             by.y = c("geo_add1_clean", "geo_city_clean", "geo_state_clean", "geo_zip_clean"),
             all.x = T, all.y = F)

# ascribe ever KC residence status
pha[, geo_kc_ever := 1] # PHA data is always 1 because everyone lived or lives in either Seattle or King County Pubic Housing

##### CREATE MCAID-MCARE-PHA ELIG_DEMO -----
  ### Create PHA elig_demo (most recent row per id) ----
  elig.pha <- copy(pha)
  setorder(elig.pha, id_apde, -from_date)
  elig.pha[, counter := 1:.N, by = c("id_apde")]
  elig.pha <- elig.pha[counter == 1]
  elig.pha[, counter := NULL]
  elig.pha <- elig.pha[, .(id_apde, dob, geo_kc_ever, start_housing, gender_me, gender_recent, gender_female, gender_male, race_me,
                           race_eth_me, race_recent, race_eth_recent, race_aian, race_asian, race_black,
                           race_nhpi, race_white, race_latino)]

  ### Identify IDs in both Mcaid-Mcare & PHA and split from non-linked IDs ----
        linked.id <- intersect(elig.mm$id_apde, elig.pha$id_apde)

        elig.pha.solo <- elig.pha[!id_apde %in% linked.id]
        elig.mm.solo <- elig.mm[!id_apde %in% linked.id]

        elig.pha.linked <- elig.pha[id_apde %in% linked.id]
        elig.mm.linked <- elig.mm[id_apde %in% linked.id]

  ### Combine the data for linked IDs ----
      # some data is assumed to be more reliable in one dataset compared to the other
      linked <- merge(x = elig.mm.linked, y = elig.pha.linked, by = "id_apde")
      setnames(linked, names(linked), gsub("\\.x$", ".elig.mm", names(linked))) # clean up suffixes to eliminate confusion
      setnames(linked, names(linked), gsub("\\.y$", ".elig.pha", names(linked))) # clean up suffixes to eliminate confusion

      # loop for vars that default to Mcaid-Mcare data
      for(i in c("dob", "gender_me", "gender_female", "gender_male", "gender_recent", "race_eth_recent", "race_recent",
                 "race_me", "race_eth_me", "race_aian", "race_asian", "race_black", "race_nhpi", "race_white", "race_latino")){
        linked[, paste0(i) := get(paste0(i, ".elig.mm"))] # default is to use Mcaid-Mcare data
        linked[is.na(get(paste0(i))), paste0(i) := get(paste0(i, ".elig.pha"))] # If NA b/c missing Mcaid-Mcare data, then fill with PHA data
        linked[, paste0(i, ".elig.mm") := NULL][, paste0(i, ".elig.pha") := NULL]
      }

      # loop for vars that default to PHA data
      for(i in c("geo_kc_ever")){
        linked[, paste0(i) := get(paste0(i, ".elig.pha"))] # default is to use Mcaid-Mcare data
        linked[is.na(get(paste0(i))), paste0(i) := get(paste0(i, ".elig.mm"))] # If NA b/c missing Mcaid-Mcare data, then fill with PHA data
        linked[, paste0(i, ".elig.pha") := NULL][, paste0(i, ".elig.mm") := NULL]
      }

      # add flag for triple linkage (Mcaid-Mcare-PHA)
      linked[, mcaid_mcare_pha := 1]

  ### Append the linked to the non-linked ----
      elig <- rbindlist(list(linked, elig.mm.solo, elig.pha.solo), use.names = TRUE, fill = TRUE)
      elig[is.na(mcaid_mcare_pha), mcaid_mcare_pha := 0] # fill in duals flag

  ### Prep for pushing to SQL ----
      # recreate race unknown indicator
      elig[, race_unk := 0]
      elig[race_aian==0 & race_asian==0 & race_asian_pi==0 & race_black==0 & race_latino==0 & race_nhpi==0 & race_white==0, race_unk := 1]

      # create time stamp
      elig[, last_run := Sys.time()]

      # order columns
      setcolorder(elig, c("id_apde", "mcaid_mcare_pha", "apde_dual"))

      # clean objects no longer used
      rm(elig.mm, elig.mm.linked, elig.mm.solo, elig.pha, elig.pha.linked, elig.pha.solo, linked)

##### CREATE MCAID-MCARE-PHA ELIG_TIMEVAR -----
  ### Create PHA elig_timevar ----
      timevar.pha <- copy(pha)
      timevar.pha <- timevar.pha[, .(id_apde, from_date, to_date,
                                     unit_add_new, unit_apt, unit_apt2, unit_city_new, unit_state_new, unit_zip_new,
                                     geo_zip_centroid, geo_street_centroid, geo_county_code,
                                     geo_tract_code, geo_hra_code, geo_school_code,
                                     agency_new, subsidy_type, vouch_type_final, operator_type, portfolio_final)]

  ### Identify IDs in both Mcaid-Mcare & PHA and split from non-linked IDs ----
      linked.id <- intersect(timevar.mm$id_apde, timevar.pha$id_apde)

      timevar.pha.solo <- timevar.pha[!id_apde %in% linked.id]
      timevar.mm.solo <- timevar.mm[!id_apde %in% linked.id]

      timevar.pha.linked <- timevar.pha[id_apde %in% linked.id]
      timevar.mm.linked <- timevar.mm[id_apde %in% linked.id]

  ### Linked IDs Part 1: Create master list of time intervals by ID ----
      #-- Create all possible permutations of date interval combinations from mcaid_mcare and pha for each id ----
      linked <- merge(timevar.pha.linked[, .(id_apde, from_date, to_date)], timevar.mm.linked[, .(id_apde, from_date, to_date)], by = "id_apde", allow.cartesian = TRUE)
      setnames(linked, names(linked), gsub("\\.x$", ".elig.pha", names(linked))) # clean up suffixes to eliminate confusion
      setnames(linked, names(linked), gsub("\\.y$", ".elig.mm", names(linked))) # clean up suffixes to eliminate confusion

      #-- Identify the type of overlaps & number of duplicate rows needed ----
      # As stated in https://github.com/PHSKC-APDE/claims_data/edit/master/claims_db/phclaims/stage/tables/load_stage.mcaid_mcare_elig_timevar.R
      # The code below was validated against a much more time intensive process where a giant table was made for every individual day within the
      # time period being analyzed. This faster / more memory efficient code was found to provide equivalent output.
      temp <- linked %>%
        mutate(overlap_type = case_when(
          # First ID the non-matches
          is.na(from_date.elig.pha) | is.na(from_date.elig.mm) ~ 0,
          # Then figure out which overlapping date comes first
          # Exactly the same dates
          from_date.elig.pha == from_date.elig.mm & to_date.elig.pha == to_date.elig.mm ~ 1,
          # PHA before mcaid_mcare (or exactly the same dates)
          from_date.elig.pha <= from_date.elig.mm & from_date.elig.mm <= to_date.elig.pha &
            to_date.elig.pha <= to_date.elig.mm ~ 2,
          # mcaid_mcare before PHA
          from_date.elig.mm <= from_date.elig.pha & from_date.elig.pha <= to_date.elig.mm &
            to_date.elig.mm <= to_date.elig.pha ~ 3,
          # mcaid_mcare dates competely within PHA dates or vice versa
          from_date.elig.mm >= from_date.elig.pha & to_date.elig.mm <= to_date.elig.pha ~ 4,
          from_date.elig.pha >= from_date.elig.mm & to_date.elig.pha <= to_date.elig.mm ~ 5,
          # PHA coverage only before mcaid_mcare (or mcaid_mcare only after PHA)
          from_date.elig.pha < from_date.elig.mm & to_date.elig.pha < from_date.elig.mm ~ 6,
          # PHA coverage only after mcaid_mcare (or mcaid_mcare only before PHA)
          from_date.elig.pha > to_date.elig.mm & to_date.elig.pha > to_date.elig.mm ~ 7,
          # Anyone rows that are left
          TRUE ~ 8),
          # Calculate overlapping dates
          from_date_o = as.Date(case_when(
            overlap_type %in% c(1, 2, 4) ~ from_date.elig.mm,
            overlap_type %in% c(3, 5) ~ from_date.elig.pha), origin = "1970-01-01"),
          to_date_o = as.Date(ifelse(overlap_type %in% c(1:5),
                                     pmin(to_date.elig.mm, to_date.elig.pha),
                                     NA), origin = "1970-01-01"),
          # Need to duplicate rows to separate out non-overlapping PHA and mcaid_mcare periods
          repnum = case_when(
            overlap_type %in% c(2:5) ~ 3,
            overlap_type %in% c(6:7) ~ 2,
            TRUE ~ 1)
        ) %>%
        select(id_apde, from_date.elig.pha, to_date.elig.pha, from_date.elig.mm, to_date.elig.mm,
               from_date_o, to_date_o, overlap_type, repnum) %>%
        arrange(id_apde, from_date.elig.pha, from_date.elig.mm, from_date_o,
                to_date.elig.pha, to_date.elig.mm, to_date_o)

      # Check no unexpected overlap types
      temp %>% group_by(overlap_type) %>% summarise(count = n())
      if (nrow(dplyr::filter(temp, overlap_type == 8)) > 0) {
        warning("Unexpected overlap types, check temp data table")
      }

      #-- Expand out rows to separate out overlaps ----
      temp_ext <- setDT(temp[rep(seq(nrow(temp)), temp$repnum), 1:ncol(temp)])

      # temp2 <- temp %>% filter(id_apde == 408970) ## DELETE LATER
      # temp_ext <- temp2[rep(seq(nrow(temp2)), temp2$repnum), 1:ncol(temp2)]
      #

      #-- Process the expanded data ----
      temp_ext[, rownum_temp := rowid(id_apde, from_date.elig.pha, to_date.elig.pha, from_date.elig.mm, to_date.elig.mm)]
      setorder(temp_ext, id_apde, from_date.elig.pha, to_date.elig.pha, from_date.elig.mm, to_date.elig.mm, from_date_o,
                              to_date_o, overlap_type, rownum_temp)
      # Remove non-overlapping dates
      temp_ext[, ':=' (
        from_date.elig.pha = as.Date(ifelse((overlap_type == 6 & rownum_temp == 2) |
                                              (overlap_type == 7 & rownum_temp == 1),
                                            NA, from_date.elig.pha), origin = "1970-01-01"),
        to_date.elig.pha = as.Date(ifelse((overlap_type == 6 & rownum_temp == 2) |
                                            (overlap_type == 7 & rownum_temp == 1),
                                          NA, to_date.elig.pha), origin = "1970-01-01"),
        from_date.elig.mm = as.Date(ifelse((overlap_type == 6 & rownum_temp == 1) |
                                             (overlap_type == 7 & rownum_temp == 2),
                                           NA, from_date.elig.mm), origin = "1970-01-01"),
        to_date.elig.mm = as.Date(ifelse((overlap_type == 6 & rownum_temp == 1) |
                                           (overlap_type == 7 & rownum_temp == 2),
                                         NA, to_date.elig.mm), origin = "1970-01-01")
      )]
      temp_ext <- unique(temp_ext)
      # Remove first row if start dates are the same or PHA is only one day
      temp_ext <- temp_ext[!(overlap_type %in% c(2:5) & rownum_temp == 1 &
                               (from_date.elig.pha == from_date.elig.mm | from_date.elig.pha == to_date.elig.pha))]
      # Remove third row if to_dates are the same
      temp_ext <- temp_ext[!(overlap_type %in% c(2:5) & rownum_temp == 3 & to_date.elig.pha == to_date.elig.mm)]

      #-- Calculate the finalized date columms----
      # Set up combined dates
      # Start with rows with only PHA or mcaid_mcare, or when both sets of dates are identical
      temp_ext[, ':=' (
        from_date = as.Date(
          case_when(
            (!is.na(from_date.elig.pha) & is.na(from_date.elig.mm)) | overlap_type == 1 ~ from_date.elig.pha,
            !is.na(from_date.elig.mm) & is.na(from_date.elig.pha) ~ from_date.elig.mm), origin = "1970-01-01"),
        to_date = as.Date(
          case_when(
            (!is.na(to_date.elig.pha) & is.na(to_date.elig.mm)) | overlap_type == 1 ~ to_date.elig.pha,
            !is.na(to_date.elig.mm) & is.na(to_date.elig.pha) ~ to_date.elig.mm), origin = "1970-01-01")
      )]
      # Now look at overlapping rows and rows completely contained within the other data's dates
      temp_ext[, ':=' (
        from_date = as.Date(
          case_when(
            overlap_type %in% c(2, 4) & rownum_temp == 1 ~ from_date.elig.pha,
            overlap_type %in% c(3, 5) & rownum_temp == 1 ~ from_date.elig.mm,
            overlap_type %in% c(2:5) & rownum_temp == 2 ~ from_date_o,
            overlap_type %in% c(2:5) & rownum_temp == 3 ~ to_date_o + 1,
            TRUE ~ from_date), origin = "1970-01-01"),
        to_date = as.Date(
          case_when(
            overlap_type %in% c(2:5) & rownum_temp == 1 ~ lead(from_date_o, 1) - 1,
            overlap_type %in% c(2:5) & rownum_temp == 2 ~ to_date_o,
            overlap_type %in% c(2, 5) & rownum_temp == 3 ~ to_date.elig.mm,
            overlap_type %in% c(3, 4) & rownum_temp == 3 ~ to_date.elig.pha,
            TRUE ~ to_date), origin = "1970-01-01")
      )]
      # Deal with the last line for each person if it's part of an overlap
      temp_ext[, ':=' (
        from_date = as.Date(ifelse((id_apde != lead(id_apde, 1) | is.na(lead(id_apde, 1))) &
                                     overlap_type %in% c(2:5) &
                                     to_date.elig.pha != to_date.elig.mm,
                                   lag(to_date_o, 1) + 1,
                                   from_date), origin = "1970-01-01"),
        to_date = as.Date(ifelse((id_apde != lead(id_apde, 1) | is.na(lead(id_apde, 1))) &
                                   overlap_type %in% c(2:5),
                                 pmax(to_date.elig.pha, to_date.elig.mm, na.rm = TRUE),
                                 to_date), origin = "1970-01-01")
      )]
      # Reorder in preparation for next phase
      setorder(temp_ext, id_apde, from_date, to_date, from_date.elig.pha, from_date.elig.mm,
               to_date.elig.pha, to_date.elig.mm, overlap_type)

      #-- Label and clean summary interval data ----
      # Identify which type of enrollment this row represents
      temp_ext[, enroll_type :=
                 case_when(
                   (overlap_type == 2 & rownum_temp == 1) |
                     (overlap_type == 3 & rownum_temp == 3) |
                     (overlap_type == 6 & rownum_temp == 1) |
                     (overlap_type == 7 & rownum_temp == 2) |
                     (overlap_type == 4 & rownum_temp %in% c(1, 3)) |
                     (overlap_type == 0 & is.na(from_date.elig.mm)) ~ "PHA",
                   (overlap_type == 3 & rownum_temp == 1) |
                     (overlap_type == 2 & rownum_temp == 3) |
                     (overlap_type == 6 & rownum_temp == 2) |
                     (overlap_type == 7 & rownum_temp == 1) |
                     (overlap_type == 5 & rownum_temp %in% c(1, 3)) |
                     (overlap_type == 0 & is.na(from_date.elig.pha)) ~ "mcaid_mcare",
                   overlap_type == 1 | (overlap_type %in% c(2:5) & rownum_temp == 2) ~ "both",
                   TRUE ~ "x"
                 )]
      # Drop rows from enroll_type == h/m when they are fully covered by an enroll_type == b
      temp_ext[, drop :=
                 case_when(
                   id_apde == lag(id_apde, 1) & !is.na(lag(id_apde, 1)) &
                     from_date == lag(from_date, 1) & !is.na(lag(from_date, 1)) &
                     to_date >= lag(to_date, 1) & !is.na(lag(to_date, 1)) &
                     # Fix up quirk from PHA data where two rows present for the same day
                     !(lag(enroll_type, 1) != "mcaid_mcare" & lag(to_date.elig.pha, 1) == lag(from_date.elig.pha, 1)) &
                     enroll_type != "both" ~ 1,
                   id_apde == lead(id_apde, 1) & !is.na(lead(id_apde, 1)) &
                     from_date == lead(from_date, 1) & !is.na(lead(from_date, 1)) &
                     to_date <= lead(to_date, 1) & !is.na(lead(to_date, 1)) &
                     # Fix up quirk from PHA data where two rows present for the same day
                     !(lead(enroll_type, 1) != "mcaid_mcare" & lead(to_date.elig.pha, 1) == lead(from_date.elig.pha, 1)) &
                     enroll_type != "both" & lead(enroll_type, 1) == "both" ~ 1,
                   # Fix up other oddities when the date range is only one day
                   id_apde == lag(id_apde, 1) & !is.na(lag(id_apde, 1)) &
                     from_date == lag(from_date, 1) & !is.na(lag(from_date, 1)) &
                     from_date == to_date & !is.na(from_date) &
                     ((enroll_type == "mcaid_mcare" & lag(enroll_type, 1) %in% c("both", "PHA")) |
                        (enroll_type == "PHA" & lag(enroll_type, 1) %in% c("both", "mcaid_mcare"))) ~ 1,
                   id_apde == lag(id_apde, 1) & !is.na(lag(id_apde, 1)) &
                     from_date == lag(from_date, 1) & !is.na(lag(from_date, 1)) &
                     from_date == to_date & !is.na(from_date) &
                     from_date.elig.pha == lag(from_date.elig.pha, 1) & to_date.elig.pha == lag(to_date.elig.pha, 1) &
                     !is.na(from_date.elig.pha) & !is.na(lag(from_date.elig.pha, 1)) &
                     enroll_type != "both" ~ 1,
                   id_apde == lead(id_apde, 1) & !is.na(lead(id_apde, 1)) &
                     from_date == lead(from_date, 1) & !is.na(lead(from_date, 1)) &
                     from_date == to_date & !is.na(from_date) &
                     ((enroll_type == "mcaid_mcare" & lead(enroll_type, 1) %in% c("both", "PHA")) |
                        (enroll_type == "PHA" & lead(enroll_type, 1) %in% c("both", "mcaid_mcare"))) ~ 1,
                   # Drop rows where the to_date < from_date due to
                   # both data sources' dates ending at the same time
                   to_date < from_date ~ 1,
                   TRUE ~ 0
                 )]

      temp_ext <- temp_ext[drop == 0 | is.na(drop)]

      # Truncate remaining overlapping end dates
      temp_ext[, to_date := as.Date(ifelse(id_apde == lead(id_apde, 1) & !is.na(lead(from_date, 1)) &
                                             from_date < lead(from_date, 1) & to_date >= lead(to_date, 1),
                                           lead(from_date, 1) - 1, to_date),
                                    origin = "1970-01-01")]

      temp_ext[, ':=' (drop = NULL, repnum = NULL, rownum_temp = NULL)]

      # With rows truncated, now additional rows with enroll_type == h/m that
      # are fully covered by an enroll_type == b
      # Also catches single day rows that now have to_date < from_date
      temp_ext[, drop := case_when(id_apde == lag(id_apde, 1) & from_date == lag(from_date, 1) &
                                     to_date == lag(to_date, 1) & lag(enroll_type, 1) == "both" &
                                     enroll_type != "both" ~ 1,
                                   id_apde == lead(id_apde, 1) & from_date == lead(from_date, 1) &
                                     to_date <= lead(to_date, 1) & lead(enroll_type, 1) == "both" ~ 1,
                                   id_apde == lag(id_apde, 1) & from_date >= lag(from_date, 1) &
                                     to_date <= lag(to_date, 1) & enroll_type != "both" &
                                     lag(enroll_type, 1) == "both" ~ 1,
                                   id_apde == lead(id_apde, 1) & from_date >= lead(from_date, 1) &
                                     to_date <= lead(to_date, 1) & enroll_type != "both" &
                                     lead(enroll_type, 1) == "both" ~ 1,
                                   TRUE ~ 0)]
      temp_ext <- temp_ext[drop == 0 | is.na(drop)]
      linked <- temp_ext[, .(id_apde, from_date, to_date, enroll_type)]

      # Catch any duplicates (there are some, have not investigated why yet)
      linked <- unique(linked)

      rm(temp, temp_ext)

  ### Linked IDs Part 2: join mcaid_mcare & PHA data based on ID & overlapping time periods ----
      # foverlaps ... https://github.com/Rdatatable/data.table/blob/master/man/foverlaps.Rd
      #-- structure data for use of foverlaps ----
      linked[, c("from_date", "to_date") := lapply(.SD, as.integer), .SDcols = c("from_date", "to_date")]
      setkey(linked, id_apde, from_date, to_date)

      timevar.pha.linked[, c("from_date", "to_date") := lapply(.SD, as.integer), .SDcols = c("from_date", "to_date")]
      setkey(timevar.pha.linked, id_apde, from_date, to_date)

      timevar.mm.linked[, c("from_date", "to_date") := lapply(.SD, as.integer), .SDcols = c("from_date", "to_date")]
      setkey(timevar.mm.linked, id_apde, from_date, to_date)

      #-- join on the mcaid_mcare linked data ----
      linked <- foverlaps(linked, timevar.mm.linked, type = "any", mult = "all")
      linked[, from_date := i.from_date] # the complete set of proper from_dates are in i.from_date
      linked[, to_date := i.to_date] # the complete set of proper to_dates are in i.to_date
      linked[, c("i.from_date", "i.to_date") := NULL] # no longer needed
      setkey(linked, id_apde, from_date, to_date)

      #-- join on the PHA linked data ----
      linked <- foverlaps(linked, timevar.pha.linked, type = "any", mult = "all")
      linked[, from_date := i.from_date] # the complete set of proper from_dates are in i.from_date
      linked[, to_date := i.to_date] # the complete set of proper to_dates are in i.to_date
      linked[, c("i.from_date", "i.to_date") := NULL] # no longer needed

  ### Append linked and non-linked data ----
      linked[, c("from_date", "to_date") := lapply(.SD, as.Date, origin = "1970-01-01"), .SDcols = c("from_date", "to_date")]
      timevar <- rbindlist(list(linked, timevar.pha.solo, timevar.mm.solo), use.names = TRUE, fill = TRUE)
      setkey(timevar, id_apde, from_date) # order dual data

  ### Collapse data if dates are contiguous and all data is the same ----
      timevar[, gr := cumsum(from_date - shift(to_date, fill=1) != 1), by = c(setdiff(names(timevar), c("from_date", "to_date")))] # unique group # (gr) for each set of contiguous dates & constant data
      timevar <- timevar[, .(from_date=min(from_date), to_date=max(to_date)), by = c(setdiff(names(timevar), c("from_date", "to_date")))]
      timevar[, gr := NULL]
      setkey(timevar, id_apde, from_date)

  ### Prep for pushing to SQL ----
      #-- Create program flags ----
      timevar[, mcare := 0][part_a==1 | part_b == 1 | part_c==1, mcare := 1]
      timevar[, mcaid := 0][!is.na(cov_type), mcaid := 1]
      timevar[, pha := 0][!is.na(agency_new), pha := 1]
      timevar[, apde_dual := 0][mcare == 1 & mcaid == 1, apde_dual := 1]
      timevar[is.na(dual), dual := 0] # is.na(dual)==T when data are only from PHA and/or Mcare
      timevar[apde_dual == 1 , dual := 1] # discussed this change via email with Alastair on 2/21/2020
      timevar[, mcaid_mcare_pha := 0][mcaid == 1 & mcare==1 & pha == 1, mcaid_mcare_pha := 1]
      timevar[, enroll_type := NULL] # kept until now for comparison with the dual flag
      if(nrow(timevar[mcare==0 & mcaid==0 & pha == 0]) > 0)
        stop("THERE IS A SERIOUS PROBLEM WITH THE TIMEVAR DATA. Mcaid, Mcare, and PHA should never all == 0")

      #-- Set Mcare/Mcaid related program flag NULLs to zero when person is only in PHA ----
      timevar[mcare == 0 & mcaid == 0 & is.na(part_a), part_a := 0]
      timevar[mcare == 0 & mcaid == 0 & is.na(part_b), part_b := 0]
      timevar[mcare == 0 & mcaid == 0 & is.na(part_c), part_c := 0]
      timevar[mcare == 0 & mcaid == 0 & is.na(partial), partial := 0]
      timevar[mcare == 0 & mcaid == 0 & is.na(buy_in), buy_in := 0]
      timevar[mcare == 0 & mcaid == 0 & is.na(full_benefit), full_benefit := 0]
      timevar[mcare == 0 & mcaid == 0 & is.na(full_criteria), full_criteria := 0]

      #-- Create contiguous flag ----
      # If contiguous with the PREVIOUS row, then it is marked as contiguous. This is the same as mcaid_elig_timevar
      timevar[, prev_to_date := c(NA, to_date[-.N]), by = "id_apde"] # MUCH faster than the shift "lag" function in data.table
      timevar[, contiguous := 0]
      timevar[from_date - prev_to_date == 1, contiguous := 1]
      timevar[, prev_to_date := NULL] # drop because no longer needed

      #-- Create cov_time_date ----
      timevar[, cov_time_day := as.integer(to_date - from_date + 1)]

      #-- Select PHA address data over Mcaid-Mcare when available ----
      # street
      timevar[!is.na(unit_add_new), geo_add1 := unit_add_new][, unit_add_new := NULL]
      # apartment
      timevar[!is.na(unit_apt), geo_add2 := unit_apt][, c("unit_apt", "unit_apt2") := NULL]
      # city
      timevar[!is.na(unit_city_new ), geo_city := unit_city_new ][, unit_city_new  := NULL]
      # state
      timevar[!is.na(unit_state_new ), geo_state := unit_state_new ][, unit_state_new  := NULL]
      # zip
      timevar[!is.na(unit_zip_new), geo_zip := unit_zip_new][, unit_zip_new := NULL]
      # other geo_ variables (note that default is already in place, only filling in gaps)
      timevar[is.na(geo_zip_centroid), geo_zip_centroid := i.geo_zip_centroid][, i.geo_zip_centroid := NULL]
      timevar[is.na(geo_street_centroid), geo_street_centroid := i.geo_street_centroid][, i.geo_street_centroid := NULL]
      timevar[is.na(geo_county_code), geo_county_code := i.geo_county_code][, i.geo_county_code := NULL]
      timevar[is.na(geo_tract_code), geo_tract_code := i.geo_tract_code][, i.geo_tract_code := NULL]
      timevar[is.na(geo_hra_code), geo_hra_code := i.geo_hra_code][, i.geo_hra_code := NULL]
      timevar[is.na(geo_school_code), geo_school_code := i.geo_school_code][, i.geo_school_code := NULL]

      #-- Add KC flag based on zip code or FIPS code as appropriate----
      kc.zips <- data.table::fread("https://raw.githubusercontent.com/PHSKC-APDE/reference-data/master/spatial_data/zip_admin.csv")
      timevar[, geo_kc := 0]
      timevar[geo_county_code=="033", geo_kc := 1]
      timevar[is.na(geo_county_code) & geo_zip %in% unique(as.character(kc.zips$zip)), geo_kc := 1]
      rm(kc.zips)

      #-- create time stamp ----
      timevar[, last_run := Sys.time()]

      #-- normalize pha variables ----
      setnames(timevar,
               c("agency_new", "subsidy_type", "vouch_type_final", "operator_type", "portfolio_final"),
               c("pha_agency", "pha_subsidy", "pha_voucher", "pha_operator", "pha_portfolio"))

      timevar[is.na(pha_agency), pha_agency := "Non-PHA"]
      timevar[pha_agency == "Non-PHA", pha_subsidy := "Non-PHA"]
      timevar[pha_agency == "Non-PHA", pha_voucher := "Non-PHA"]
      timevar[pha_agency == "Non-PHA", pha_operator := "Non-PHA"]
      timevar[pha_agency == "Non-PHA", pha_portfolio := "Non-PHA"]

      #-- clean up ----
      rm(linked, pha, timevar.mm, timevar.mm.linked, timevar.mm.solo, timevar.pha, timevar.pha.linked, timevar.pha.solo)

##### WRITE ELIG_DEMO TO SQL ----
  ### Write to SQL ----
  # Pull YAML from GitHub
  table_config_demo <- yaml::yaml.load(httr::content(httr::GET(yaml.elig)))

  # Ensure columns are in same order in R & SQL & that we drop extraneous variables
  keep.elig <- names(table_config_demo$vars)
  elig <- elig[, ..keep.elig]

  # Write table to SQL
  # Split into smaller tables to avoid SQL connection issues
  start <- 1L
  max_rows <- 100000L
  cycles <- ceiling(nrow(elig)/max_rows)

  lapply(seq(start, cycles), function(i) {
    start_row <- ifelse(i == 1, 1L, max_rows * (i-1) + 1)
    end_row <- min(nrow(elig), max_rows * i)

    message("Loading cycle ", i, " of ", cycles)
    if (i == 1) {
      dbWriteTable(db_apde51,
                   DBI::Id(schema = table_config_demo$schema, table = table_config_demo$table),
                   value = as.data.frame(elig[start_row:end_row]),
                   overwrite = T, append = F,
                   field.types = unlist(table_config_demo$vars))
    } else {
      dbWriteTable(db_apde51,
                   DBI::Id(schema = table_config_demo$schema, table = table_config_demo$table),
                   value = as.data.frame(elig[start_row:end_row]),
                   overwrite = F, append = T)
    }
  })

  ### Simple QA ----
      #-- confirm that all rows were loaded to SQL ----
      stage.count <- as.numeric(odbc::dbGetQuery(db_apde51, "SELECT COUNT (*) FROM stage.mcaid_mcare_pha_elig_demo"))
      if(stage.count != nrow(elig))
        stop("Mismatching row count, error writing data")

      #-- check that rows in stage are not less than the last time that it was created ----
      last_run <- as.POSIXct(odbc::dbGetQuery(db_apde51, "SELECT MAX (last_run) FROM stage.mcaid_mcare_pha_elig_demo")[[1]]) # data for the run that was just uploaded

      # count number of rows
      previous_rows <- as.numeric(
        odbc::dbGetQuery(db_apde51,
                         "SELECT c.qa_value from
                             (SELECT a.* FROM
                             (SELECT * FROM metadata.qa_mcaid_mcare_pha_values
                             WHERE table_name = 'stage.mcaid_mcare_pha_elig_demo' AND
                             qa_item = 'row_count') a
                             INNER JOIN
                             (SELECT MAX(qa_date) AS max_date
                             FROM metadata.qa_mcaid_mcare_pha_values
                             WHERE table_name = 'stage.mcaid_mcare_pha_elig_demo' AND
                             qa_item = 'row_count') b
                             ON a.qa_date = b.max_date)c"))

      if(is.na(previous_rows)){previous_rows = 0}

      row_diff <- stage.count - previous_rows

      if (row_diff < 0) {
        odbc::dbGetQuery(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                             (last_run, table_name, qa_item, qa_result, qa_date, note)
                             VALUES ({last_run},
                             'stage.mcaid_mcare_pha_elig_demo',
                             'Number new rows compared to most recent run',
                             'FAIL',
                             {Sys.time()},
                             'There were {row_diff} fewer rows in the most recent table
                             ({stage.count} vs. {previous_rows})')",
                         .con = db_apde51))

        problem.elig.row_diff <- glue::glue("Fewer rows than found last time.
                                           Check metadata.qa_mcaid_mcare_pha for details (last_run = {last_run})
                                           \n")
      } else {
        odbc::dbGetQuery(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                             (last_run, table_name, qa_item, qa_result, qa_date, note)
                             VALUES ({last_run},
                             'stage.mcaid_mcare_pha_elig_demo',
                             'Number new rows compared to most recent run',
                             'PASS',
                             {Sys.time()},
                             'There were {row_diff} more rows in the most recent table
                             ({stage.count} vs. {previous_rows})')",
                         .con = db_apde51))

        problem.elig.row_diff <- glue::glue(" ") # no problem, so empty error message

      }

      #-- check that the number of distinct IDs not less than the last time that it was created ----
      # get count of unique id
      current.unique.id <- as.numeric(odbc::dbGetQuery(
        db_apde51, "SELECT COUNT (DISTINCT id_apde)
            FROM stage.mcaid_mcare_pha_elig_demo"))

      previous.unique.id <- as.numeric(
        odbc::dbGetQuery(db_apde51,
                         "SELECT c.qa_value from
                             (SELECT a.* FROM
                             (SELECT * FROM metadata.qa_mcaid_mcare_pha_values
                             WHERE table_name = 'stage.mcaid_mcare_pha_elig_demo' AND
                             qa_item = 'id_count') a
                             INNER JOIN
                             (SELECT MAX(qa_date) AS max_date
                             FROM metadata.qa_mcaid_mcare_pha_values
                             WHERE table_name = 'stage.mcaid_mcare_pha_elig_demo' AND
                             qa_item = 'id_count') b
                             ON a.qa_date = b.max_date)c"))

      if(is.na(previous.unique.id)){previous.unique.id = 0}

      id_diff <- current.unique.id - previous.unique.id

      if (id_diff < 0) {
        odbc::dbGetQuery(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                             (last_run, table_name, qa_item, qa_result, qa_date, note)
                             VALUES ({last_run},
                             'stage.mcaid_mcare_pha_elig_demo',
                             'Number distinct IDs compared to most recent run',
                             'FAIL',
                             {Sys.time()},
                             'There were {id_diff} fewer IDs in the most recent table
                             ({current.unique.id} vs. {previous.unique.id})')",
                         .con = db_apde51))

        problem.elig.id_diff <- glue::glue("Fewer unique IDs than found last time.
                                           Check metadata.qa_mcaid_mcare_pha for details (last_run = {last_run})
                                           \n")
      } else {
        odbc::dbGetQuery(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                             (last_run, table_name, qa_item, qa_result, qa_date, note)
                             VALUES ({last_run},
                             'stage.mcaid_mcare_pha_elig_demo',
                             'Number distinct IDs compared to most recent run',
                             'PASS',
                             {Sys.time()},
                             'There were {id_diff} more IDs in the most recent table
                             ({current.unique.id} vs. {previous.unique.id})')",
                         .con = db_apde51))

        problem.elig.id_diff <- glue::glue(" ") # no problem, so empty error message
      }

  ### Fill qa_mcare_values table ----
  qa.values <- glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha_values
                                (table_name, qa_item, qa_value, qa_date, note)
                                VALUES ('stage.mcaid_mcare_pha_elig_demo',
                                'row_count',
                                {stage.count},
                                {Sys.time()},
                                '')",
                              .con = db_apde51)

  DBI::dbExecute(conn = db_apde51, qa.values)

  qa.values2 <- glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha_values
                                (table_name, qa_item, qa_value, qa_date, note)
                                VALUES ('stage.mcaid_mcare_pha_elig_demo',
                                'id_count',
                                {current.unique.id},
                                {Sys.time()},
                                '')",
                               .con = db_apde51)

  DBI::dbExecute(conn = db_apde51, qa.values2)

##### WRITE ELIG_TIMEVAR TO SQL ----
  ### Write to SQL ----
  # Pull YAML from GitHub
  table_config_timevar <- yaml::yaml.load(httr::content(httr::GET(yaml.timevar)))

  # Ensure columns are in same order in R & SQL & are limited those specified in the YAML
  keep.timevars <- names(table_config_timevar$vars)
  timevar <- timevar[, ..keep.timevars]

  setcolorder(timevar, names(table_config_timevar$vars))

  # Write table to SQL
  # Split into smaller tables to avoid SQL connection issues
  start <- 1L
  max_rows <- 100000L
  cycles <- ceiling(nrow(timevar)/max_rows)

  lapply(seq(start, cycles), function(i) {
    start_row <- ifelse(i == 1, 1L, max_rows * (i-1) + 1)
    end_row <- min(nrow(timevar), max_rows * i)

    message("Loading cycle ", i, " of ", cycles)
    if (i == 1) {
      dbWriteTable(db_apde51,
                   DBI::Id(schema = table_config_timevar$schema, table = table_config_timevar$table),
                   value = as.data.frame(timevar[start_row:end_row]),
                   overwrite = T, append = F,
                   field.types = unlist(table_config_timevar$vars))
    } else {
      dbWriteTable(db_apde51,
                   DBI::Id(schema = table_config_timevar$schema, table = table_config_timevar$table),
                   value = as.data.frame(timevar[start_row:end_row]),
                   overwrite = F, append = T)
    }
  })

  ### Simple QA ----
      #-- confirm that all rows were loaded to SQL ----
      stage.count <- as.numeric(odbc::dbGetQuery(db_apde51, "SELECT COUNT (*) FROM stage.mcaid_mcare_pha_elig_timevar"))
      if(stage.count != nrow(timevar))
        stop("Mismatching row count, error writing data")

      #-- check that rows in stage are not less than the last time that it was created ----
      last_run <- as.POSIXct(odbc::dbGetQuery(db_apde51, "SELECT MAX (last_run) FROM stage.mcaid_mcare_pha_elig_timevar")[[1]]) # data for the run that was just uploaded

      # count number of rows
      previous_rows <- as.numeric(
        odbc::dbGetQuery(db_apde51,
                         "SELECT c.qa_value from
                         (SELECT a.* FROM
                         (SELECT * FROM metadata.qa_mcaid_mcare_pha_values
                         WHERE table_name = 'stage.mcaid_mcare_pha_elig_timevar' AND
                         qa_item = 'row_count') a
                         INNER JOIN
                         (SELECT MAX(qa_date) AS max_date
                         FROM metadata.qa_mcaid_mcare_pha_values
                         WHERE table_name = 'stage.mcaid_mcare_pha_elig_timevar' AND
                         qa_item = 'row_count') b
                         ON a.qa_date = b.max_date)c"))

      if(is.na(previous_rows)){previous_rows = 0}

      row_diff <- stage.count - previous_rows

      if (row_diff < 0) {
        DBI::dbExecute(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                         (last_run, table_name, qa_item, qa_result, qa_date, note)
                         VALUES ({last_run},
                         'stage.mcaid_mcare_pha_elig_timevar',
                         'Number new rows compared to most recent run',
                         'FAIL',
                         {Sys.time()},
                         'There were {row_diff} fewer rows in the most recent table
                         ({stage.count} vs. {previous_rows})')",
                         .con = db_apde51))

        problem.timevar.row_diff <- glue::glue("Fewer rows than found last time.
                                       Check metadata.qa_mcaid_mcare_pha for details (last_run = {last_run})
                                       \n")
      } else {
        DBI::dbExecute(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                         (last_run, table_name, qa_item, qa_result, qa_date, note)
                         VALUES ({last_run},
                         'stage.mcaid_mcare_pha_elig_timevar',
                         'Number new rows compared to most recent run',
                         'PASS',
                         {Sys.time()},
                         'There were {row_diff} more rows in the most recent table
                         ({stage.count} vs. {previous_rows})')",
                         .con = db_apde51))

        problem.timevar.row_diff <- glue::glue(" ") # no problem, so empty error message

      }

      #-- check that the number of distinct IDs not less than the last time that it was created ----
      # get count of unique id
      current.unique.id <- as.numeric(odbc::dbGetQuery(
        db_apde51, "SELECT COUNT (DISTINCT id_apde)
        FROM stage.mcaid_mcare_pha_elig_timevar"))

      previous.unique.id <- as.numeric(
        odbc::dbGetQuery(db_apde51,
                         "SELECT c.qa_value from
                         (SELECT a.* FROM
                         (SELECT * FROM metadata.qa_mcaid_mcare_pha_values
                         WHERE table_name = 'stage.mcaid_mcare_pha_elig_timevar' AND
                         qa_item = 'id_count') a
                         INNER JOIN
                         (SELECT MAX(qa_date) AS max_date
                         FROM metadata.qa_mcaid_mcare_pha_values
                         WHERE table_name = 'stage.mcaid_mcare_pha_elig_timevar' AND
                         qa_item = 'id_count') b
                         ON a.qa_date = b.max_date)c"))

      if(is.na(previous.unique.id)){previous.unique.id = 0}

      id_diff <- current.unique.id - previous.unique.id

      if (id_diff < 0) {
        DBI::dbExecute(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                         (last_run, table_name, qa_item, qa_result, qa_date, note)
                         VALUES ({last_run},
                         'stage.mcaid_mcare_pha_elig_timevar',
                         'Number distinct IDs compared to most recent run',
                         'FAIL',
                         {Sys.time()},
                         'There were {id_diff} fewer IDs in the most recent table
                         ({current.unique.id} vs. {previous.unique.id})')",
                         .con = db_apde51))

        problem.timevar.id_diff <- glue::glue("Fewer unique IDs than found last time.
                                       Check metadata.qa_mcaid_mcare_pha for details (last_run = {last_run})
                                       \n")
      } else {
        DBI::dbExecute(
          conn = db_apde51,
          glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha
                         (last_run, table_name, qa_item, qa_result, qa_date, note)
                         VALUES ({last_run},
                         'stage.mcaid_mcare_pha_elig_timevar',
                         'Number distinct IDs compared to most recent run',
                         'PASS',
                         {Sys.time()},
                         'There were {id_diff} more IDs in the most recent table
                         ({current.unique.id} vs. {previous.unique.id})')",
                         .con = db_apde51))

        problem.timevar.id_diff <- glue::glue(" ") # no problem, so empty error message
      }

  ### Fill qa_mcare_values table ----
  qa.values <- glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha_values
                            (table_name, qa_item, qa_value, qa_date, note)
                            VALUES ('stage.mcaid_mcare_pha_elig_timevar',
                            'row_count',
                            {stage.count},
                            {Sys.time()},
                            '')",
                              .con = db_apde51)

  DBI::dbExecute(conn = db_apde51, qa.values)

  qa.values2 <- glue::glue_sql("INSERT INTO metadata.qa_mcaid_mcare_pha_values
                            (table_name, qa_item, qa_value, qa_date, note)
                            VALUES ('stage.mcaid_mcare_pha_elig_timevar',
                            'id_count',
                            {current.unique.id},
                            {Sys.time()},
                            '')",
                               .con = db_apde51)

  DBI::dbExecute(conn = db_apde51, qa.values2)

### Print error messages and load to final ----
  #-- create summary of errors
  problems <- glue::glue(
    problem.timevar.row_diff, "\n",
    problem.timevar.id_diff, "\n",
    problem.elig.row_diff, "\n",
    problem.elig.id_diff
  )

  if(problems >1){
    message(glue::glue("WARNING ... MCAID_MCARE_PHA_ELIG_TIMEVAR OR ELIG_DEMO FAILED AT LEAST ONE QA TEST", "\n",
                       "Summary of problems in new tables: ", "\n",
                       problems))
  } else {
    message("Staged MCAID_MCARE_PHA_ELIG_TIMEVAR & ELIG_DEMO passed all QA tests")

    # Load to final schema (permissions should be in place but not working)
    # Use SQL code file for now
        alter_schema_f(conn = db_apde51,
                   from_schema = "stage", to_schema = "final",
                   table_name = "mcaid_mcare_pha_elig_demo")

    alter_schema_f(conn = db_apde51,
                   from_schema = "stage", to_schema = "final",
                   table_name = "mcaid_mcare_pha_elig_timevar")

    # Add index
    # (need to update schema name in the config file first)
    table_config_demo$schema <- "final"
    table_config_timevar$schema <- "final"

    add_index_f(db_apde51, table_config = table_config_demo)
    add_index_f(db_apde51, table_config = table_config_timevar)
    }

# the end ----


pdf_file<-"pdf/dotcharts_overlay.pdf"
cairo_pdf(bg="grey98", pdf_file,width=7,height=10)

library(Hmisc) # because of dotchart2, only there add=T can be used
par(omi=c(0.15,0.75,0.95,0.75),mai=c(0.9,1.75,0.25,0),family="Lato Light",las=1)

# Import data and prepare chart

myData<-read.xls("myData/Bechert_Graph.xlsx",sheet=1, encoding="latin1")
row.names(myData)<- myData$Countries
myData$Countries<-NULL

total<- myData["Mean . . . . . . . . . . ",]
myData<- myData[rownames(myData)!="Mean . . . . . . . . . . ",]

myDatasort <- myData [order(-myData$Happiness),]
myDatasort <-rbind(myDatasort,total)
attach(myDatasort)

myC1<-rgb(255,165,0,190,maxColorValue=255)
myC2<-rgb(0,0,139,190,maxColorValue=255)
myC3<-rgb(100,0,0,190,maxColorValue=255)

myC1g<-rgb(255,165,0,60,maxColorValue=255)
myC2g<-rgb(0,0,139,60,maxColorValue=255)
myC3g<-rgb(100,0,0,60,maxColorValue=255)

# Create chart and other elements

dotchart2(Religiosity.,labels=row.names(myDatasort),pch=17,dotsize=4,cex=0.6,cex.labels=0.75,xlab="",col=myC1,xaxis=F,xlim=c(1,100))
dotchart2(Involvement,labels=row.names(myDatasort),pch=15,dotsize=4,cex=0.6,xlab="",col=myC2,xaxis=F,add=T)
dotchart2(Happiness,labels=row.names(myDatasort),pch=19,dotsize=4,cex=0.6,xlab="",col=myC3,xaxis=F,add=T)

axis(1)
axis(3)

abline(v=total,col=c(myC1g,myC2g,myC3g),lwd=12)
legend(-5,-2.6,c("Religious Involvement"),ncol=1,pch=15,col=myC2,bty="n",cex=1.5,pt.cex=1.5,xpd=T)
legend(35,-2.6,c("Self-assessed Religiosity"),ncol=1,pch=17,col=myC1,bty="n",cex=1.5,pt.cex=1.5,xpd=T)

legend(80,-2.6,c("Happiness"),ncol=1,pch=19,col=myC3,bty="n",cex=1.5,pt.cex=1.5,xpd=T)

# Titling

mtext("Religious Involvement, Self-assessed Religiosity, and Happiness ",3,line=3.75,adj=0,cex=1.05,family="Lato Black",outer=T)
mtext("(Mean values scaled from 0 to 100, Data from 2008)",3,line=1.25,adj=0,cex=0.90,font=3,outer=T)
mtext("Source: ISSP Data Report Religious Attitudes and Religious Change",1,line=-1,adj=1,cex=0.90,font=3,outer=T)

dev.off()


library(tidyverse)
library(lubridate)
library(data.table)

df = read.table("bank/bank-full.csv", header = T, sep = ";")
drop = c("poutcome", "previous", "pdays", "month", "contact", "day")
df = df[,!(names(df) %in% drop)]
df
write.csv(df, "bank-full-updated.csv", row.names = F)

df = read.table("bank/bank-full-updated.csv", header = T, sep = ",")
head(df)
unique(df$job , incomparables = FALSE)
unique(df$marital , incomparables = FALSE)
unique(df$education , incomparables = FALSE)
unique(df$default , incomparables = FALSE)
unique(df$balance , incomparables = FALSE)
unique(df$housing , incomparables = FALSE)
unique(df$loan , incomparables = FALSE)
unique(df$contact , incomparables = FALSE)
unique(df$day , incomparables = FALSE)
unique(df$month , incomparables = FALSE)
unique(df$duration , incomparables = FALSE)
unique(df$campaign , incomparables = FALSE)
unique(df$pdays , incomparables = FALSE)
unique(df$previous , incomparables = FALSE)
unique(df$poutcome , incomparables = FALSE)
unique(df$y , incomparables = FALSE)

names(df)[names(df) == "y"] = "subscribed_term_deposit"

df$subscribed_term_deposit[df$subscribed_term_deposit == "no"] = 0
df$subscribed_term_deposit[df$subscribed_term_deposit == "yes"] = 1

df$job[df$job == "unknown"] = NA
df$education[df$education == "unknown"] = NA

df = na.omit(df)
write.csv(df, "bank-full-updated.csv", row.names = F)
head(df)
df = read.table("bank-full-updated.csv", header = T, sep = ",")
head(df)


library(dplyr)

###############################################################
## Global parameters
###############################################################
reset_params <- function(){
  lf        <<- 0.15       # latency factor
  le        <<- 1       # latency exponent
  rth 	      <<- -1.5    # retrieval threshold
  bll       <<- 0.5     # decay parameter
  ans       <<- 0.15    # activation noise
  mas       <<- 1       # maximum associative strength
  mp        <<- 1.5       # mismatch penalty
  ga         <<- 1      # goal source activation
  rand_time <<- 3       # latency variability
  lp        <<- 1       # default time since last presentation (sec)
  blc       <<- 0       # base-level activation
  ##
  ## Distractor control:
  ldp       <<- 1       # last distractor presentation (sec)
  dbl       <<- 0       # distractor base-level
  ndistr    <<- 1				# number of distractors
  ##
  ## Cue weighting, cue confusion and activation-sensitivity:
  # cueweights <<- c(1,1) # vector of cue weightings
  cueweighting <<- 1     # Strength of structural cue as ratio str/sem
  normalizeWeights <<- TRUE
  pc        <<- 0       # prominence correction factor C
  pco 	    <<- 1.3     # prominence correction offset x_0
  cuesim    <<- -1      # cue-feature similarity [-1..0]
  cl 				<<- 0 			# cue confusion level (0-100)
}
reset_params()

cuesim2cl <- function(x=cuesim){
	cl <<- (x+1)*100
	cl
}

cl2cuesim <- function(x=cl){
	cuesim <<- x/100-1
	cuesim
}

strWeight <- function(ratio=cueweighting, normalize=normalizeWeights){
  ifelse(normalize, ratio/(ratio+1)*2, ratio)
}
semWeight <- function(ratio=cueweighting, normalize=normalizeWeights){
  ifelse(normalize, 1/(ratio+1)*2, 1)
}

idnames <- c("Set","Iteration","Condition","Target","Distractor")
actrnames <- c("fan1","fan2","weights","bl1","bl2","times1","times2","noise1","noise2","blact1","blact2","fs1","fs2","act1","act2","activation","latency","retrieved","acc","miss","fail")
paramnames <- c("lf","le","rth","bll","ans","mas","mp","ga","rand_time","lp","blc","ldp","dbl","ndistr","cueweighting","pc","pco","cuesim","cl")

###############################################################
## RUN MODEL
###############################################################
#model <- model_4cond
run <- function(model, iterations=1000){
	##
	## PARAMETER MATRIX
	##
	print("creating parameter matrix...")
	#
	parameters <- list(lf,le,rth,bll,ans,mas,mp,ga,rand_time,lp,blc,ldp,dbl,ndistr,cueweighting,pc,pco,cuesim,cl)
	#
	n_params <- length(parameters);
	#
	## The total number of combinations is the product of the number of values
	## for each parameter
	n_sets <- prod(unlist(lapply(parameters, length)))
	n_cond <- length(model$target_fan)
	total <- iterations*n_sets*n_cond
	#
	print(paste("Conditions: ",n_cond))
	print(paste("Combinations: ",n_sets))
	print(paste("Total runs: ",total))
	#
	## Set up matrix of parameter combinations.  Rows are model experiments,
	## columns are parameters.
	param_combs <- matrix(nrow=n_sets, ncol=n_params);
	#
	cumulative_num_combs <- 1;
	for (p in 1:n_params) {
		param_combs[,p] <- rep(parameters[p][[1]], each=cumulative_num_combs, length.out=n_sets);
		cumulative_num_combs <- cumulative_num_combs * length(parameters[p][[1]]);
	}
	#
	param_matrix <- matrix(data=t(param_combs), nrow=total,ncol=n_params, byrow=TRUE);

	##
	## DATA TABLE
	##
	print("creating data table...")
	#
	condnames <- 1:length(model$target_fan)
	# c("lf","le","bll","ans","mas","mp","rth","rand_time","w","lp","ldp","blc","dbl","pc","pco","cl","cuesim","cueweighting","ndistr")
	header <- c(idnames,paramnames,actrnames)
#
	id_matrix <- matrix(nrow=total, ncol=length(idnames))
	actr_matrix <- matrix(nrow=total, ncol=length(actrnames))
	d <- data.frame(cbind(id_matrix,param_matrix,actr_matrix))
	colnames(d) <- header
# d$chunk <- rep(chunknames,total/n_chunks)
	d$Set <- 1:n_sets
	d$Condition <- rep(condnames, each=n_sets)
	d$Target <- rep(model$Target, each=n_sets)
	d$Distractor <- rep(model$Distractor, each=n_sets)
	d$fan1 <- rep(model$target_fan, each=n_sets)
	d$fan2 <- rep(model$distractor_fan, each=n_sets)
	d$Iteration <- rep(1:iterations, each=n_sets*n_cond)
	d$times1 <- d$lp
	d$times2 <- d$ldp
	d$bl1 <- d$blc
	d$bl2 <- d$dbl
	d$cl <- (cuesim+1)*100
	d$weights <- model$weights
	d$noise1 <- act_r_noise_n(total, d$ans)
	d$noise2 <- act_r_noise_n(total, d$ans)
	head(d)

	##
	## ACTIVATION
	##
	print("computing activations...")
	#
	fan1<-matrix(unlist(d$fan1),nrow=total,ncol=length(d$fan1[[1]]),byrow=TRUE)
	fan2<-matrix(unlist(d$fan2),nrow=total,ncol=length(d$fan1[[1]]),byrow=TRUE)
	weights<-matrix(unlist(d$weights),nrow=total,ncol=2,byrow=TRUE)
	#
	fan1 <- ifelse(fan1==0,NA,fan1)
	fan2 <- ifelse(fan2==0,NA,fan2)
	f1 <- ifelse(!is.na(fan1) & fan1>0, 1, 0)
	f2 <- ifelse(!is.na(fan2) & fan2>0, 1, 0)
	match1 <- f1-1
	match2 <- f2-1
	d$blact1 <- activation(fan=fan1, match=match1, bl=d$bl1, times=d$times1, weights=weights, noise=d$noise1, W=d$ga, dec=d$bll, S=d$mas, P=d$mp)
	d$blact2 <- activation(fan=fan2, match=match2, bl=d$bl2, times=d$times2, weights=weights, noise=d$noise2, W=d$ga, dec=d$bll, S=d$mas, P=d$mp)
	#
	d$fs1 <- fan_strength(d$blact1,d$blact2, C=d$pc, x0=d$pco)
	d$fs2 <- fan_strength(d$blact2,d$blact1, C=d$pc, x0=d$pco)
  #
  print("computing cue confusion and fan strength...")
  #
	cueconf1 <- cbind(f2[,-1],f2[,1])*(1+d$cuesim)
	ffan1 <- fan1*1+(f2+cueconf1)*d$ndistr*d$fs1
	cueconf2 <- cbind(f1[,-1],f1[,1])*(1+d$cuesim)
	ffan2 <- fan2*d$ndistr+(f1+cueconf2)*1*d$fs2
	#
	d$act1 <- activation(fan=ffan1, match=match1, bl=d$bl1, times=d$times1, weights=weights, noise=d$noise1, W=d$ga, dec=d$bll, S=d$mas, P=d$mp)
	d$act2 <- activation(fan=ffan2, match=match2, bl=d$bl2, times=d$times2, weights=weights, noise=d$noise2, W=d$ga, dec=d$bll, S=d$mas, P=d$mp)

	##
	## FINAL VALUES
	##
	print("computing final values...")
	d$activation <- ifelse(d$act1>d$act2, d$act1, d$act2)
	retrieved <- ifelse(d$act1>d$act2, 1, 2)
	d$retrieved <- ifelse(d$activation>d$rth, retrieved, 0)
	d$latency <- latency(d$activation, F=d$lf, f=d$le, tau=d$rth)
	d$acc <- ifelse(d$retrieved==1, 1, 0)
	d$miss <- ifelse(d$retrieved==2, 1, 0)
	d$fail <- ifelse(d$retrieved==0, 1, 0)
	#
	print("FINISHED")
	#
	return(tbl_df(d))
}

###############################################################
## ACT-R
###############################################################
activation <- function(fan=matrix(c(1,1),1,2,T), match=matrix(c(0,0),1,2,T), weights=matrix(c(1,1),1,2,T), times=lp, bl=blc, noise=act_r_noise(ans), W=ga, dec=bll, S=mas, P=mp){
  Wkj <- W*weights/rowSums(weights)
  base_act <- log(times^(-dec)) + bl
  Sji <- S-log(fan)
  Sji <- ifelse(Sji==Inf | is.na(Sji), 0, Sji)
  ifelse(Sji < 0, print("!!! WARNING: Sji < 0 !!!"), T)
  Sji <- ifelse(Sji < 0, 0, Sji)
  Pi <- rowSums(P*match)
  act <- base_act + rowSums(Wkj*Sji) + Pi + noise
  return(act)
}

latency <- function(A, F=lf, f=le, tau=rth){
  t <- ifelse(A>=tau, F*exp(-f*A)*1000, F*exp(-f*tau)*1000)
  round(randomize_time(t))
}

act_r_noise_n <- function(n, s=ans){
  var <- pi^2/3*s^2
  rnorm(n, 0, sqrt(var))
}

act_r_noise <- function(s=ans){
  var <- pi^2/3*s^2
  rnorm(1, 0, sqrt(var))
}

## Random component ##
randomize_time <- function(time, n=rand_time){
  if(n>0) runif(length(time), time*(n-1)/n, time*(n+1)/n) else time
}

fan_strength <- function(a1, a2, C=pc, x0=pco){
  ifelse(C > 0, 1/(1+exp(-C*(x0-(a1-a2)))), 1)
}

noise_off <- function(){
  ans <<- 0
  rand_time <<- 0
}

noise_on <- function(){
  ans <<- 0.15
  rand_time <<- 3
}


options(scipen = 9999999, digits = 22)
library(dplyr)
library(readxl)
library(readr)
library(bit64)

# SAIL Labs
# ~Mihir

## Description:
##-------------
#* This file will read all the csv, select the Screenid and keeps the unique userids only.
#*  Then you can specify people and number of rows you want to keep in each file. It is meant to
#*  help with botometer.
##-------------

library(data.table)

# first read all the files in a folder (Give the path to folder (....), ending /)
setwd('./htyyt/')

#filenames
files <- list.files( pattern="*csv$")

#read only columns that we want
temp <- lapply(files, function(x) data.table::fread(x, select = c("Screenid")))
data <- data.table::rbindlist(temp, fill = T) #make a df

#remove the duplicates userids
n_original <-  data[!duplicated(data$Screenid), ]

#sample 100K with probablity sample without replacements
set.seed(786)
rand_data <- data.frame(Screenid= sample( bit64::as.integer64(n_original$Screenid), nrow(n_original), replace = F), stringsAsFactors = F)

# Here I want 20000 rows per file until last row is reached
# this method forces the execution from innermost, outer () opttional
groups <- (split(rand_data, (seq(nrow(rand_data))-1) %/% 2537))
people <- c("1_user", "2_user", "3_user", "4_user", "5_user")

#loop through end of each split, and write file with i
for (i in seq_along(groups)) {
  readr::write_csv(groups[[i]], paste0("output_", people[i], ".csv"))
}


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

#             dddddddd
#             d::::::d  iiii                                          RRRRRRRRRRRRRRRRR
#             d::::::d i::::i                                         R::::::::::::::::R
#             d::::::d  iiii                                          R::::::RRRRRR:::::R
#             d:::::d                                                 RR:::::R     R:::::R
#     ddddddddd:::::d iiiiiiivvvvvvv           vvvvvvvaaaaaaaaaaaaa     R::::R     R:::::R
#   dd::::::::::::::d i:::::i v:::::v         v:::::v a::::::::::::a    R::::R     R:::::R
#  d::::::::::::::::d  i::::i  v:::::v       v:::::v  aaaaaaaaa:::::a   R::::RRRRRR:::::R
# d:::::::ddddd:::::d  i::::i   v:::::v     v:::::v            a::::a   R:::::::::::::RR
# d::::::d    d:::::d  i::::i    v:::::v   v:::::v      aaaaaaa:::::a   R::::RRRRRR:::::R
# d:::::d     d:::::d  i::::i     v:::::v v:::::v     aa::::::::::::a   R::::R     R:::::R
# d:::::d     d:::::d  i::::i      v:::::v:::::v     a::::aaaa::::::a   R::::R     R:::::R
# d::::::ddddd::::::ddi::::::i       v:::::::v      a::::a    a:::::a RR:::::R     R:::::R
#  d:::::::::::::::::di::::::i        v:::::v       a:::::aaaa::::::a R::::::R     R:::::R
#   d:::::::::ddd::::di::::::i         v:::v         a::::::::::aa:::aR::::::R     R:::::R
#    ddddddddd   dddddiiiiiiii          vvv           aaaaaaaaaa  aaaaRRRRRRRR     RRRRRRR

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

# # # load utilities script
#  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
source('utils.r')

# # # Initialize model parameters
#  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
model <- list(num_blocks    = 20,
			  num_inits     = 5,
			  wts_range     = 1,
			  num_hids      = 3,
			  learning_rate = 0.15,
			  beta_val      = 5,
			  out_rule      = 'sigmoid') # anything else runs linear

# # # The demo below trains the DIVA model on the Shepard, Hovland,
# # # and Jenkins' elemental types (1961) plus one 4-class problem.
# # # This demo can be used as a template for your own problem.
#  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #

# # # create training results
training = matrix(rep(0, model$num_blocks * 7), ncol = 7)

# # # initialize model and run it on each SHJ category structure
for (category_type in 1:7) {

  # # # get shj stimuli
  cases <- demo_cats(category_type)
  model$inputs <- cases$inputs
  model$labels <- cases$labels

  # # # train model
  result <- run_diva(model)

# # # add result to training matrix
training[,category_type] <- result$training

}

# # # display results
print(training)
train_plot(training)
save.image('diva_run.rdata')

warnings()


setwd("C:/Users/Bigghost/Documents/GitHub/AutomatedOmicsCompendiumPreparationPipeline/utilities/imputation")
data = read.csv("data0.0_50.csv",header=F)

library(snow)
library(missForest)
library(doParallel)
cl <- makeCluster(8,type="SOCK")
registerDoParallel(cl)
rf_result = missForest(data,verbose = T,parallelize ='variables')


library(tidyverse)
library(stringr)

results_table <-function(yhat, yhat_rounded, y){
  logical_test <- matrix(0L, dim(y)[1], dim(y)[2])
  logical_test <- ifelse(y == yhat_rounded, "True", "False")

  yhat = as.data.frame(yhat)
  yhat_rounded = as.data.frame(yhat_rounded)
  y = as.data.frame(as.matrix(y)) # y is numeric
  logical_test = as.data.frame(logical_test)

  yhat %>%
    cbind(yhat_rounded) %>%
    cbind(y) %>%
    cbind(logical_test) -> result_df
  colnames(result_df) <- c("yhat", "yhat_rounded", "y", "logical_test")

  View(result_df)

  sum(str_count(result_df$logical_test, "True")) -> true_count
  sum(str_count(result_df$logical_test, "False")) -> false_count

  true_count <- as.double(true_count)
  false_count <-as.double(false_count)

  success_perc <- true_count/(true_count + false_count)*100

  print(paste0("Percentage of rows successfully trained: ",
               as.character(format(round(success_perc, 2), nsmall = 2)), "%"))

  return(result_df)

}


# download data 'neuroblastoma' and plot profile.id = 4, chromosome = 4, x=position, y=logratio
if(!require(neuroblastoma)) {
    install.packages("neuroblastoma")
}

# import and load neuroblastoma dataset
library('neuroblastoma')
data('neuroblastoma')

# using np as neuro.profiles for profile data
np = neuroblastoma$profiles
xy = np[np$profile.id == 4 & np$chromosome == 2, ]
x = xy$position
y = xy$logratio

svg('Easy/task1a.svg')
plot(x, y, type='l', main="Neuroblastoma Data", xlab='position in base pair', ylab='normalized logratio of the probe')
grid()
legend(x=x[5], y=-0.5,legend="position vs logpoint data", col="black", lty=1, cex=0.8, bg='lightblue')
dev.off()


# (13) #########

print("Not in parallel")
nt<-10
mymat<-matrix(nrow=nt,ncol=nt)
mymat[1:nt,]<-0
bsum=0
bsum<-for(ijk in 1:nt  )  {
	set.seed(ijk)
	mymat[,ijk]<-rnorm(mymat[,ijk])
}
print(bsum)
print(mymat)
#readline(prompt = "NEXT>")


library(tidyverse)
library(leaflet)

G_PROJ4DEF <- '+proj=lcc +lat_1=49 +lat_2=77 +lat_0=49 +lon_0=-95 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs'
G_CRS_CODE <- 'EPSG:3978'

#####################3
#
# This is supposed to let me color the points on the leaflet map but it is not working
#
pal <- leaflet::colorNumeric(viridis_pal(option = "C")(10), domain = 1:300)

#####################################333
#
# Aggregate points and resize for the leaflet plot
#
aggregate_points <- function(data_points, round_digit = 0, size_adjust = 10000){
  data_points %>%
    select(Long, Lat, City) %>%
    mutate_if(is.numeric, round, round_digit) %>%
    group_by(Long, Lat) %>%
    summarise(n = n(), City = paste0(unique(City), collapse = "; ")) %>%
    #count(Long, Lat, sort = T) %>%
    mutate(Size = sqrt(n)*size_adjust) %>%
    mutate(Popup = paste0(City, "\nN=",n))
}

get_prov_shp <- function(){
  canada_HR_shp <- read_sf(file.path("HR000b11a_e_Oct2013_simp.geojson")) %>%
    st_transform(canada_shp, crs = G_PROJ4DEF)
}

get_hr_shp <- function(){
  shp <- read_sf(file.path("HR000b11a_e_Oct2013_simp.geojson")) %>%
    st_transform(shp, crs = G_PROJ4DEF)
}
get_pr_shp <- function(){
  shp <- read_sf(file.path("canada_pt_sim.geojson")) %>%
    st_transform(shp, crs = G_PROJ4DEF)
}

canada_HR_shp %>%
  ggplot() +
  geom_sf() +
  theme_map()

canada_prov_shp <- read_sf(file.path("canada_pt_sim.geojson")) %>%
  st_transform(canada_shp, crs = G_PROJ4DEF)

canada_prov_shp %>%
  ggplot() +
  geom_sf(alpha = 0, size = 1.25, color = "black") +
  theme_map()

##########################333
#
# Get a BASE leaflet map
#
get_leaflet_map <- function(){

  bnds =  c(-7786476.885838887,
            -5153821.09213678,
            7148753.233541353,
            7928343.534071138
  )

  res <- c(
    38364.660062653464,
    22489.62831258996,
    13229.193125052918,
    7937.5158750317505,
    4630.2175937685215,
    2645.8386250105837,
    1587.5031750063501,
    926.0435187537042,
    529.1677250021168,
    317.50063500127004,
    185.20870375074085,
    111.12522225044451,
    66.1459656252646,
    38.36466006265346,
    22.48962831258996,
    13.229193125052918,
    7.9375158750317505,
    4.6302175937685215,
    2.6458386250105836,
    1.5875031750063502,
    0.92604351875370428,
    0.52916772500211673,
    0.31750063500127002,
    0.18520870375074083,
    0.11112522225044451,
    0.066145965625264591
  )

  orgn <- c(-34655800, 39310000)

  urlTemplate = "https://geoappext.nrcan.gc.ca/arcgis/rest/services/BaseMaps/CBMT3978/MapServer/tile/{z}/{y}/{x}?m4h=t"

  tile_attrib <- "NRCAN"

  epsg3978 <- leafletCRS(
    crsClass = "L.Proj.CRS",
    code = G_CRS_CODE,
    proj4def = G_PROJ4DEF,
    origin = orgn,
    bounds =  bnds,
    resolutions = res
  )

  m <- leaflet(options = leafletOptions(worldCopyJump = F,
                                        crs = epsg3978,
                                        minZoom = 2, maxZoom = 17)
  ) %>%
    addTiles(urlTemplate = urlTemplate,#x
             attribution = tile_attrib,
             options = tileOptions(continuousWorld = F)
    ) %>%
    # addMarkers(lng = -75.705793,
    #            lat = 45.345134,
    #            popup = "My office."
    # ) %>%
    setView(lng = -1*(96+(40/60)+(35/3600)),
            lat = 62+(24/60),
            zoom = 3
    )

  m
}


suppressMessages(library(fmlr))

if (fml_mpi()){
  m = 2
  n = 3
  g = grid()
  x = mpimat(g, m, n)

  source("internals/common.r")

  cmp(x$dim(), c(m, n))

  # ------------------------------------------------------------------------------
  # fill
  # ------------------------------------------------------------------------------

  x$fill_val(1)
  test = x$to_robj()
  truth = matrix(1, m, n)
  cmp(test, truth)

  x$fill_eye()
  test = x$to_robj()
  truth = diag(1, m, n)
  cmp(test, truth)

  x$fill_zero()
  test = x$to_robj()
  truth = matrix(0, m, n)
  cmp(test, truth)

  x$fill_val(3)
  test = x$to_robj()
  truth = matrix(3, m, n)
  cmp(test, truth)

  x$fill_linspace(1, m*n)
  test = x$to_robj()
  truth = matrix(1:(m*n), m, n)
  cmp(test, truth)

  # ------------------------------------------------------------------------------
  # misc
  # ------------------------------------------------------------------------------

  # TODO
  # x$fill_linspace(1, m*n)
  # x$rev_rows()
  # test = x$to_robj()
  # truth = matrix(1:(m*n), m, n)[m:1, ]
  # cmp(test, truth)
  #
  # x$rev_cols()
  # test = x$to_robj()
  # truth = matrix(1:(m*n), m, n)[m:1, n:1]
  # cmp(test, truth)

  x$fill_linspace(1, 6)
  x$scale(1000)
  test = x$to_robj()
  truth = matrix(1:(m*n) * 1000, m, n)
  cmp(test, truth)
} # end if (fml_mpi())


#!/usr/bin/env Rscript

args <- commandArgs(trailingOnly=TRUE)

if(length(args) == 3) {

    stopifnot(file.exists(args[2]))
    stopifnot(file.exists(args[3]))

    library(DSS)
    require(bsseq)

    s1_fn <- args[2]
    s2_fn <- args[3]

    dmr_fn <- paste(args[1], "DMRs.txt", sep='.')
    dml_fn <- paste(args[1], "DMLs.txt", sep='.')

    s1 = read.table(s1_fn, header=TRUE)
    s2 = read.table(s2_fn, header=TRUE)
    BSobj = makeBSseqData(list(s1, s2), c('s1', 's2'))

    dmlTest = DMLtest(BSobj, group1=c('s1'), group2=c('s2'), smoothing=TRUE)
    dmrs = callDMR(dmlTest, p.threshold=0.05)

    write.table(dmrs, file=dmr_fn, quote=F, sep='\t')

    dmls = callDML(dmlTest, p.threshold=1)
    write.table(dmls, file=dml_fn, quote=F, sep='\t')

}

if(length(args) != 3) {
    cat("usage: dss.r <sample name> <DSS_input_1.txt> <DSS_input_2.txt>\n")
}


"""
<?xml version="1.0" encoding="UTF-8"?>
  <graphml xmlns="http://graphml.graphdrawing.org/xmlns"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
         http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
  <!-- Created by igraph -->
  <key id="v_color" for="node" attr.name="color" attr.type="double"/>
  <key id="v_id" for="node" attr.name="id" attr.type="string"/>
  <graph id="G" edgedefault="directed">
  <node id="n0">
  <data key="v_color">3</data>
  <data key="v_id">n0</data>
  </node>
  <node id="n1">
  <data key="v_color">1</data>
  <data key="v_id">n1</data>
  </node>
  <node id="n2">
  <data key="v_color">1</data>
  <data key="v_id">n2</data>
  </node>
  <node id="n3">
  <data key="v_color">1</data>
  <data key="v_id">n3</data>
  </node>
  <edge source="n1" target="n0">
  </edge>
  <edge source="n2" target="n0">
  </edge>
  <edge source="n3" target="n0">
  </edge>
  </graph>
  </graphml>
"""


#Pacote para visualização de dados no RStudio
library(ggplot2)
# base de dados - dataset -
mpg #dados dos carros
?mpg #info
View(mpg)
View(read.csv("tabela_fipe.csv",header = TRUE,encoding = "UTF-8"))
#Gerando grafico
ggplot(mpg, aes(displ,cty))+geom_point()


library(xlsx)

 library(RColorBrewer)

 #options(digits=2)
 ##读取t_for的大小
k1<-read.xlsx("t_for.xls", sheetName = "0.2", header = TRUE)
k2<-read.xlsx("t_for.xls", sheetName = "0.3", header = TRUE)
k3<-read.xlsx("t_for.xls", sheetName = "0.4", header = TRUE)
k4<-read.xlsx("t_for.xls", sheetName = "0.5", header = TRUE)

v<-4.66e-13  #弯月面体积大小

q<-c(2.5e-14, 4.5e-13, 9e-13, 3e-12)   #流量从1.5到180

k<-c(0.2,0.3,0.4,0.5) #占空比

pchc<-c(19,22,23,24)

mycolors<-c("red","blue", "darkgreen", "yellow3")

h<-0.3e-3 #弯月面变形大小

duty<-1-k

par(mfrow=c(2,2), mar=c(4,2,2,2), oma=c(2,2,2,2))

#######占空比0.2####
plot(k1[,1],  (v+(duty[1]*q[1]))/(k1[,1]*k1[,2]^2), log="x",lwd=2, xlab=expression(log(italic(f["v"])) (Hz)), ylab=expression(italic(F)), main="k=0.2", col=0, pch=pchc[1], ylim=c(0,8e-14))

lines(lowess(k1[,1],  (v+(duty[1]*q[1]))/(k1[,1]*k1[,2]^2)), col=mycolors[1], lwd=2.5,lty=2)

for(i in 1:3){

points(k1[,1], (v+(duty[1]*q[i+1]))/(k1[,1]*k1[,i+2]^2),pch=pchc[i+1], lwd=2, col=0)
lines(lowess(k1[,1], (v+(duty[1]*q[i+1]))/(k1[,1]*k1[,i+2]^2)), lwd=2.5, col=mycolors[i+1], lty=2)
}

legend("topleft",c("1.5nl/min", "27nl/min","54nl/min","180nl/min"), type="b", col=mycolors, pch=pchc,lty=2, lwd=2, bty="n")

abline(v=250, col="red", lwd=2, lty=3)
#abline(h= (v+(duty[1]*q[2]))/(k1[11,1]*k1[11,3]^2), col="blue", lwd=2, lty=3)
#abline(h= (v+(duty[1]*q[3]))/(k1[11,1]*k1[11,4]^2), col="darkgreen", lwd=2,lty=3)
#abline(h= (v+(duty[1]*q[4]))/(k1[11,1]*k1[11,5]^2), col="yellow3", lty=3,lwd=2)
text(200, 2e-14,"250Hz", col="red", font=2, cex=1)
#text(20, 1.2e-14,(v+(duty[1]*q[2]))/(k1[11,1]*k1[11,3]^2),font=2, col="blue", cex=1)
#text(20, 1.4e-14, (v+(duty[1]*q[4]))/(k1[11,1]*k1[11,5]^2), font=2, col="darkgreen", cex=1)
#text(20, 1.6e-14,(v+(duty[1]*q[4]))/(k1[11,1]*k1[11,5]^2) ,font=2,col="yellow3", cex=1)

#####占空比0.3####
plot(k2[,1],  (v+(duty[2]*q[1]))/(k2[,1]*k2[,2]^2), log="x",lwd=2, xlab=expression(log(italic(f["v"])) (Hz)), ylab=expression(italic(F)), main="k=0.3", col=0, pch=pchc[1], ylim=c(0,3e-14))

lines(lowess(k2[,1],  (v+(duty[2]*q[1]))/(k2[,1]*k2[,2]^2)), col=mycolors[1], lwd=2.5,lty=2)

for(i in 1:3){

points(k2[,1], (v+(duty[2]*q[i+1]))/(k2[,1]*k2[,i+2]^2),pch=pchc[i+1], lwd=2, col=0)
lines(lowess(k2[,1], (v+(duty[2]*q[i+1]))/(k2[,1]*k2[,i+2]^2)), lwd=2.5, col=mycolors[i+1], lty=2)
}

legend("topleft",c("1.5nl/min", "27nl/min","54nl/min","180nl/min"), type="b",col=mycolors, pch=pchc, lwd=2, bty="n")

abline(v=250, col="red", lwd=2,lty=3)
abline(v=300, col="blue", lwd=2,lty=3)
#abline(h= (v+(duty[2]*q[2]))/(k2[11,1]*k2[11,3]^2), col="blue", lwd=2, lty=3)
#abline(h= (v+(duty[2]*q[3]))/(k2[11,1]*k2[11,4]^2), col="darkgreen", lwd=2,lty=3)
#abline(h= (v+(duty[2]*q[4]))/(k2[11,1]*k2[11,5]^2), col="yellow3", lty=3,lwd=2)

text(100, 1e-14,"250Hz",col="red", font=2, cex=1)
text(200, 1.5e-14,"300Hz",font=2, col="blue", cex=1)
#text(20, 1.4e-14,(v+(duty[2]*q[3]))/(k2[11,1]*k2[11,4]^2) ,font=2, col="darkgreen", cex=1)
#text(20, 1.6e-14,(v+(duty[2]*q[4]))/(k2[11,1]*k2[11,5]^2),font=2,col="yellow3", cex=1)

###占空比0.4###
plot(k3[,1],  (v+(duty[3]*q[1]))/(k3[,1]*k3[,2]^2), log="x", lwd=2, xlab=expression(log(italic(f["v"])) (Hz)), ylab=expression(italic(F)), main="k=0.4", col=0, pch=pchc[1], ylim=c(0,3e-14))

lines(lowess(k3[,1],  (v+(duty[3]*q[1]))/(k3[,1]*k3[,2]^2)), col=mycolors[1], lwd=2.5,lty=2)

for(i in 1:3){

points(k3[,1], (v+(duty[3]*q[i+1]))/(k3[,1]*k3[,i+2]^2),pch=pchc[i+1], lwd=2, col=0)
lines(lowess(k3[,1], (v+(duty[3]*q[i+1]))/(k3[,1]*k3[,i+2]^2)), lwd=2.5, col=mycolors[i+1], lty=2)
}

legend("topleft",c("1.5nl/min", "27nl/min","54nl/min","180nl/min"), type="b",col=mycolors, pch=pchc, lwd=2, bty="n")

abline(v=250, col="red", lwd=2,lty=3)
abline(v=500, col="blue", lwd=2,lty=3)
#abline(h= (v+(duty[3]*q[2]))/(k3[11,1]*k3[11,3]^2), col="blue", lwd=2, lty=3)
#abline(h= (v+(duty[3]*q[3]))/(k3[11,1]*k3[11,4]^2), col="darkgreen", lwd=2,lty=3)
#abline(h= (v+(duty[3]*q[4]))/(k3[11,1]*k3[11,5]^2), col="yellow3", lty=3,lwd=2)
text(100, 1e-14,"250Hz", col="red", font=2, cex=1)
text(200, 1.5e-14,"500Hz",font=2, col="blue", cex=1)
#text(20, 1.4e-14,(v+(duty[3]*q[3]))/(k3[11,1]*k3[11,4]^2),font=2, col="darkgreen", cex=1)
#text(20, 1.6e-14,(v+(duty[3]*q[4]))/(k3[11,1]*k3[11,5]^2),font=2,col="yellow3", cex=1)

####占空比0.5####
plot(k4[,1],  (v+(duty[4]*q[1]))/(k4[,1]*k4[,2]^2),log="x", lwd=2, xlab=expression(log(italic(f["v"])) (Hz)), ylab=expression(italic(F)), main="k=0.5", col=0, pch=pchc[1], ylim=c(0,3e-14))

lines(lowess(k3[,1],  (v+(duty[3]*q[1]))/(k3[,1]*k3[,2]^2)), col=mycolors[1], lwd=2.5,lty=2)

for(i in 1:3){

points(k3[,1], (v+(duty[3]*q[i+1]))/(k3[,1]*k3[,i+2]^2),pch=pchc[i+1], lwd=2, col=0)
lines(lowess(k4[,1], (v+(duty[4]*q[i+1]))/(k4[,1]*k4[,i+2]^2)), lwd=2.5, col=mycolors[i+1], lty=2)
}
legend("topleft",c("1.5nl/min", "27nl/min","54nl/min","180nl/min"), type="b",col=mycolors, pch=pchc, lwd=2, bty="n")

abline(v=300, col="red", lwd=2,lty=3)
abline(v=900, col="blue", lwd=2,lty=3)
#abline(h= (v+(duty[4]*q[2]))/(k4[11,1]*k4[11,3]^2), col="blue", lwd=2, lty=3)
#abline(h= (v+(duty[4]*q[3]))/(k4[11,1]*k4[11,4]^2), col="darkgreen", lwd=2,lty=3)
#abline(h= (v+(duty[4]*q[4]))/(k4[11,1]*k4[11,5]^2), col="yellow3", lty=3,lwd=2)
text(50, 1e-14,"300Hz", col="red", font=2, cex=1)
text(200, 1.5e-14,"900Hz",font=2, col="blue", cex=1)
#text(20, 1.4e-14,(v+(duty[4]*q[3]))/(k4[11,1]*k4[11,4]^2),font=2, col="darkgreen", cex=1)
#text(20, 1.6e-14,(v+(duty[4]*q[4]))/(k4[11,1]*k4[11,5]^2),font=2,col="yellow3", cex=1)

#mtext("External forces with Q & K in fv & tfor"，side=1, line=0, col="red", cex=1, adj=1,outer=TRUE)


#!/usr/bin/env Rscript

####################
#
# Parameters:
# 1 - File to scale
# 2 - Output file to store new dataset
# 3 - Independent variable
#
###################

args <- commandArgs(trailingOnly = TRUE)
training = read.csv(args[1], check.names=FALSE)

# Saving mu and sigma
get_scale <- function (x) {
  k = scale(x)
  return(attr(k,"scaled:scale"))
}
get_center <- function (x) {
  k = scale(x)
  return(attr(k,"scaled:center"))
}

scale_values <- data.frame(apply(training,2, get_scale))
center_values <- data.frame(apply(training,2, get_center))

training_scaled=scale(training)

#Shift to the right in order to avoid negative values
training_scaled <- training_scaled + 300

#Replacing original values for some columns
independent = args[5]
training_scaled[,independent] <- training[,independent]

if("timestamp" %in% colnames(training_scaled)){
  training_scaled[,"timestamp"] <- training$timestamp
}
if("Core_1CPU" %in% colnames(training_scaled)){
  training_scaled[,"Core_1CPU"] <- training$Core_1CPU
}
if("Core_2CPU" %in% colnames(training_scaled)){
  training_scaled[,"Core_2CPU"] <- training$Core_2CPU
}
if("numSockets" %in% colnames(training_scaled)){
  training_scaled[,"numSockets"] <- training$numSockets
}

# Remove NaN
training_scaled[is.na(training_scaled)] <- 0

#training_scaled <- round(training_scaled,6)

write.csv(training_scaled, file = args[2],row.names=FALSE)
saveRDS(center_values, file = args[3])
saveRDS(scale_values, file = args[4])


#' @export
 Association.plot <- function (data, hydro, strata.group, species = NULL, subset, plot = TRUE, ...) {
    attach(data)
    if (!missing(subset)) {
        data <- data[subset, ]
    }
    detach("data")
    strata.use <- is.element(data$Strata, strata.group$Strata)
    nHy = hydro
    hydro <- (data[hydro])[strata.use, ]
    if (is.null(species))
        species <- rep.int(1, length(hydro))
    else species <- (data[species])[strata.use, ]

    Strata <- data$Strata[strata.use]
    if (is.null(species))
        species <- rep.int(1, length(hydro))
    tempy <- cbind(hydro, species, Strata)
    if (any(is.na(hydro)))
        tempy <- (na.omit(as.data.frame(tempy)))
    hydro <- as.numeric(tempy[, 1])
    species <- as.numeric(as.vector(tempy[, 2]))
    Strata <- as.numeric(tempy[, 3])
    WH <- strata.group$NH
    na.strata <- match(strata.group$Strata, unique(Strata))
    WH[is.na(na.strata)] <- NA
    IWH <- cbind(strata.group$Strata, WH)
    IWH <- (na.omit(as.data.frame(IWH)))
    WH <- as.numeric(IWH$WH)
    IWH <- IWH[[1]]
    WH <- (WH/sum(WH))
    yhi <- split(species, Strata)
    nh <- as.vector(sapply(yhi, length))
    yst <- sum(WH * as.vector(sapply(yhi, mean)))
    sort.hydro <- unique(sort(hydro))
    wh <- WH/(nh * yst)
    Whi <- rep(0, length(species))
    for (i in seq(along = wh)) Whi[c(Strata == IWH[i])] <- wh[i]
    Whi <- Whi * species
    gt <- cumsum(sapply(split(Whi, hydro), sum))
    res <- list(x = sort.hydro, y = as.vector(gt))
    if (plot) {
        Association.int.plot(res, xlab=nHy)
        invisible(res)
    }
    else {
        class(res) <- "assocplot"
        res
    }
}


#' lost_productivity
#'
#' Calculate the percentage in worker's lost productivity due to heat conditions.
#'
#' @param wbgt numeric Wetbulb globe temperature index in degC
#' @param tresh numeric treshshold for loss in degC
#'
#' @return percentage of productivity lost
#'
#' @author    Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#'
#' @keywords  Body Surface Area
#' @export
#'
#'
#'
#'

lost_productivity=function(wbgt,tresh=33.5) {
  ct$assign("wbgt", as.array(wbgt))
  ct$assign("tresh", as.array(tresh))
  ct$eval("var res=[]; for(var i=0, len=wbgt.length; i < len; i++){ res[i]=lost_productivity(wbgt[i],tresh[0])};")
  res=ct$get("res")
  return(res)
}


## -------------------------- Data preparation --------------------------------

## Source wrapper ----
## WARNING: wrapper erase all data in memory, run it with at the beggining;
## also, it will load several custum functions without which ANYTHING below
## will work as expected.

source("~/Documentos/2019A/paper_gen_decrement/analysis/r/wrapper.r")

# Paths for processed data. Check raw2processed_proc.r ----

path_read.general = "~/Documentos/2019A/paper_gen_decrement/Data/"
path_read.BL = path_read.general + "processed/baseline"
path_read.EXP = path_read.general + "processed/experimental"

# Paths for results of analysis (data_results) ----

path_save.general = "~/Documentos/2019A/paper_gen_decrement/analysis/"
path_save.data = path_save.general + "data_results/"

# ETC
## vector of subjects numbers, used in several functions below
subjects_vec = 326:333
## Names of phases
ph_names = c("Baseline", "Experimental")
# Path of BL and EXP to read
paths = c(path_read.BL, path_read.EXP)

## Extra: individual trial analysis for the FI ----
df_bp1_fi <- ind_ana_bp1(
  list_ss = subjects_vec,
  phases_names = ph_names,
  paths = paths,
  sessions = 40,
  max_trials = 2000
) %>%
  filter(sesion < 39) %>%
  as.data.frame()

colores = c('#8c8c8c', "#8F2727")

ses = unique(df_bp1_fi$sesion)
cdes = unique(df_bp1_fi$cde)
trial = unique(df_bp1_fi$cum_trial)
phase = unique(df_bp1_fi$phase)

df1 = df_bp1_fi %>%
  group_by(phase, sesion, cde) %>%
  summarise(bp = mean(bp))

par(mfrow = c(1, 2))
cdes = c(1, 2)

for(i in unique(df1$phase)){

  xmax = max(df1$sesion[df1$phase == i])
  ymax = 45
  ymin = min(df1$bp)

  plot(0,0, ylab = '', xlab = '',
       col = 'white', ylim = c(ymin, ymax), xlim = c(0, xmax))

  for (k in cdes){

    if (k == cdes[1]){
      col = colores[1]
    } else {
      col = colores[2]
    }
    x = df1$sesion[df1$cde == k & df1$phase == i]
    y = df1$bp[df1$cde == k & df1$phase == i]
    points(x,y, pch = 21, bg = col)
    lines(x,y, col = col)
  }
}

dF = data.frame()

for (i in phase) {
  di = df_bp1_fi[df_bp1_fi$phase == i, ]

  for (ii in ses){

    dii = di[di$sesion == ii, ]

    for (iii in cdes) {
      diii = dii[dii$cde == iii, ]
      sumr = sum(length(diii$r2) > 0 & length(diii$r2 > 0))
      if( sumr > 0) {
        ratio = mean(diii$r2 / diii$r1)
        ratio = log10(ratio)
        dFtmp = data.frame(phase = i, ses = ii, cde = iii, ratio = ratio)
      } else {
        dFtmp = data.frame()
      }

      dF = bind_rows(dF, dFtmp)
    }
  }
}

pdf('ts_logRatio.pdf',
    height = 4, width = 7)

par(mfrow = c(1, 2))

cdes = c(1, 2)
for (pi in phase) {

  xmax = max(dF$ses[dF$phase == pi])
  ymax = max(dF$ratio)
  ymin = min(dF$ratio)
  plot(NA,NA, xlim = c(1, xmax), ylim = c(ymin, ymax), axes = F,
       xlab = 'Sessions', ylab = TeX('$\\log_{10}$ mean ratio'),
       main = pi, panel.first = grid())

  for (cdi in cdes) {
    if (cdi == 1){
      col = colores[1]
    } else {
      col = colores[2]
    }
    x = dF$ses[dF$phase == pi & dF$cde == cdi]
    y = dF$ratio[dF$phase == pi & dF$cde == cdi]
    points(x, y, pch = 21, bg = col)
    lines(x, y, col = col)
  }
  if (pi == phase[1]){
    legend('topleft', legend = c('Delayed','Immediate'),
           col = colores, pch = c(16, 16), bty = 'n')
  }
  axis(1, tck = -0.02, seq(0, xmax, 5))
  axis(2, tck = -0.02)
}

dev.off()

pdf('density_logRatio.pdf',
    height = 4, width = 7)

par(mfrow = c(1, 2),
    mar = c(4,1,3,1))
cdes = c(1, 2)

for (pi in phase) {

  for (cdi in cdes){

    x = dF$ratio[dF$phase == pi & dF$cde == cdi]
    dx1 = density(x)

    if(pi == phase[1]){
      xlim = c(1, 1.8)
      ylim = c(0, 12)
    } else {
      xlim = c(1, 1.8)
      ylim = c(0, 12)
    }

    if (cdi == 1){
      col = colores[1]
      plot(dx1, type ='l',
           xlim = xlim, ylim = ylim,
           ylab = '', xlab = TeX('$\\log_{10}$ mean ratio'),
           main = pi, col = col,
           axes = F, panel.first = grid())

    } else {
      col = colores[2]
      lines(dx1, col = col)
    }
  }
  axis(1, tck = -0.02)
  if (pi == phase[1]){
    legend('topleft', legend = c('Delayed','Immediate'),
           col = colores, pch = c(16, 16), bty = 'n')
  }

}

dev.off()

# Quarter life analysis

quants0 <- quants25.75(
  list_ss = subjects_vec,
  phases_names = ph_names,
  paths = paths,
  sessions = 40,
  max_trials = 2000
) %>%
  filter(sesion < 39) %>%
  as.data.frame()

quants = quants0 %>%
  group_by(cde, phase, sesion) %>%
  summarise(q25 = mean(q25),
            q75 = mean(q75))

ses = unique(quants$sesion)
cdes = unique(quants$cde)
ph = unique(quants$phase)

par(mfrow = c(1, 2),

    )

for (pi in ph){
  if (pi == ph[1]) {
    xlims = c(0, 40)
  } else {
    xlims = c(0, 30)
  }
  ylims = c(30, 80)
  plot(0,0, color = 'white',
       xlab = '', ylab = '',
       xlim = xlims, ylim = ylims)

  for (ci in cdes){

    if ( ci == cdes[1]) {

      col = colores[1]

    } else {

      col = colores[2]
    }

    x = quants$sesion[quants$cde == ci & quants$phase == pi]
    y = quants$q25[quants$cde == ci & quants$phase == pi]
    y1 = quants$q75[quants$cde == ci & quants$phase == pi]
    points(x, y, pch = 21, bg = col)
    points(x, y1, pch = 21, bg = col)
  }
}