narisi.place.po.regijah <- function(place_po_regijah) {

  imena <-unique(place_po_regijah$STATISTICNA_REGIJA)
  for (ime in imena){
    graph1 <- ggplot(data=place_po_regijah%>%filter(STATISTICNA_REGIJA==ime,STAROST != "65 let >"),
                     aes(x=LETO,y=Moški)) +
      geom_point() +
      geom_smooth(fill="blue",
                  colour="darkblue", size=1) +
      facet_grid(.~STAROST)

    graph1 <- graph1 + geom_point(aes(x=LETO,y=Ženske)) +
      geom_smooth(aes(x=LETO,y=Ženske), fill="red",
                  colour="red", size=1,alpha=0.1) +
      facet_grid(~STAROST)

    graph1 <- graph1 +
      ggtitle(paste("Regija -", ime)) +
      theme_bw() +
      theme(plot.title = element_text(hjust = 0.5),
            axis.text.x = element_text(angle = -40, vjust = 1, hjust = 0)) +
      ylab("Plača") +
      xlab("Leto")

    print(graph1)
  }

}

box.plot.po.regijah <- function(place_po_regijah,spol="Moški") {
      color = "blue"
      aes1 = aes(x=STATISTICNA_REGIJA, y=Moški,color=STAROST)
      if (spol == "Moški"){
        aes1 = aes(x=STATISTICNA_REGIJA, y=Moški,color=STAROST)
      }else {
        aes1 = aes(x=STATISTICNA_REGIJA, y=Ženske,color=STAROST)
        color = "red"
      }

      place_po_regijah%>%filter(STAROST != "65 let >",STAROST != "15-64 let") %>%
        ggplot(aes1) +
        geom_jitter() +
        geom_boxplot(color=color,fill=color, alpha=I(0.01)) +
        theme_bw()+
        ggtitle("Razpršenost plač po regijah")+
        theme(plot.title = element_text(hjust = 0.5, colour = "darkblue"),
              axis.text.x = element_text(angle = -20, vjust = 1, hjust = 0)) +
        ylab("Plača") +
        xlab("Statistična regija")
}
box.plot.po.regijah(place_po_regijah)

placa_po_izobrazbi <- function(place_po_sektorju) {
  place_po_sektorju %>%
    filter(SEKTOR != "1 Javni in zasebni sektor - SKUPAJ") %>%
    ggplot(aes(x=IZOBRAZBA,y=POVPRECNA_PLACA)) +
    geom_jitter() +
    geom_boxplot(color="blue",fill="blue",size=1,alpha=I(0.3)) +
    theme_bw()+
    ggtitle("Razpršenost plač po izobrazbi")+
    theme( plot.title = element_text(hjust = 0.5),
           axis.text.x = element_text(angle = -10, vjust = 1, hjust = 0)) +
    ylab("Plača") +
    xlab("Izobrazba")

}

delez.zaposlenih.v.sektorjih.po.placah <- function(place_po_sektorju,placa=2000) {

  place_po_sektorju %>%
    filter(SEKTOR != "1 Javni in zasebni sektor - SKUPAJ",
           POVPRECNA_PLACA > 2000,
           SEKTOR != "11 Javni sektor - SKUPAJ",
           IZOBRAZBA != "Izobrazba - Skupaj") %>% # samo visokošolska izobrazba
    ggplot(aes(x=SPOL, fill=factor(SEKTOR))) +
    geom_bar(position="fill",color="black",alpha=I(0.8))+
    theme_bw() +
    ggtitle("Delež zaposlenih v posameznih sektorjih z visokošolsko izobrazbo")+
    theme( plot.title = element_text(hjust = 0.5),
           legend.background = element_blank(),
           legend.box.background = element_rect(colour = "black")) +
    ylab("Delež") +
    xlab("Spol") +
    guides(fill=guide_legend("SEKTOR"))

}

placa_po_sektorjih <- function(place_po_sektorju) {

  place_po_sektorju %>%
    filter(SEKTOR != "1 Javni in zasebni sektor - SKUPAJ",
           IZOBRAZBA != "Izobrazba - Skupaj",
           SPOL != "Spol - SKUPAJ") %>%
    ggplot(aes(x=SEKTOR,y=POVPRECNA_PLACA,color=IZOBRAZBA)) +
    geom_jitter() +
    geom_boxplot(color="orange",fill="orange",size=1,alpha=I(0.1)) +
    theme_bw()+
    ggtitle("Razpršenost plač po sektorjih",)+
    theme( plot.title = element_text(hjust = 0.5),
           axis.text.x = element_text(angle = -10, vjust = 1, hjust = 0.1),
           legend.background = element_blank(),
           legend.box.background = element_rect(colour = "black")) +
    ylab("Plača") +
    xlab("Sektor")
}

placa_po_dejavnosti <- function(place_po_dejavnosti) {

    placa<- place_po_dejavnosti %>%
    rowwise() %>%
    mutate(SKUPNO = sum(SKUPNO/12,na.rm=TRUE)) %>%
    group_by(REGIJA) %>%
    top_n(1,SKUPNO) %>%
     mutate(REGIJA = replace(REGIJA,which(REGIJA=="Posavska"),"Spodnjeposavska")) %>%
     mutate(REGIJA = replace(REGIJA,which(REGIJA=="Primorsko-notranjska"),"Notranjsko−kraška"))

    zemljevid.place <- zemljevid_slovenije %>% left_join(placa, by=c("NAME_1"="REGIJA"))
    zemljevid.place$DEJAVNOST <- sub("^[ [:upper:] ]", "",zemljevid.place$DEJAVNOST)

    ggplot(zemljevid.place, aes(x=long, y=lat, fill=DEJAVNOST, label=paste0(NAME_1, "\n", " "))) +
      geom_polygon(aes(group=group)) +
      geom_text(data=zemljevid.place %>% group_by(NAME_1,DEJAVNOST)  %>%
                  summarise(long=mean(long), lat=mean(lat)), size=5, colour="black",angle=-0) +
      theme(axis.line=element_blank(),
            axis.text.x=element_blank(),
            axis.text.y=element_blank(),
            axis.ticks=element_blank(),
            axis.title.x=element_blank(),
            axis.title.y=element_blank(),
            panel.background=element_blank(),
            panel.border=element_blank(),
            panel.grid.major=element_blank(),
            panel.grid.minor=element_blank(),
            plot.background=element_blank(),
            legend.text = element_text(size=10),
            legend.box.background = element_rect(colour = "black")) +
      labs(fill="Dejavnost")

}


# evaluate randomly selected protected areas against shifts in species distribution
# calculate species gains, losses, turnover, etc.

############
## Flags
############

# choose the rcps (get to choose two)
rcps <- c(26, 85)

# select initial and final timeperiod for these grids
periods <- c('2007-2020', '2081-2100')

# network parameters
temps <- c(0.01, seq(0.1, 1,length.out = 10)) # how many steps of temperature extent (0 to 100%)
sizes <- c(0.01, seq(0.05, 0.5, length.out = 10)) # which steps of area (could be 0 to 100%).
nreps <- 3 # how many repeats at each combination of lat and size

####################
## helper functions
####################
require(data.table)

##################################################
# Generate random MPA networks
# Across gradients of area and temperature extent
##################################################
clim <- fread('gunzip -c output/climatology.csv.gz', drop = 1) # climatology from Morley et al. 2018
regions <- fread('gunzip -c output/region_grid.csv.gz', drop = 1) # CMSP region definitions from 5.0_define_CMSP.r

# round to analysis grids (0.25) and aggregate
clim[, lat := floor(latClimgrid/0.25)*0.25 + 0.25/2]
clim[, lon := floor(lonClimgrid/0.25)*0.25 + 0.25/2]
clim <- clim[, .(sbt = mean(sbt)), by = .(lat, lon)]

# merge climatology and region: the planning units
clim <- merge(clim, regions[, .(latgrid, longrid, region)], by.x = c('lat', 'lon'), by.y = c('latgrid', 'longrid'))

# the regions to analyze
regs <- as.character(regions[,sort(unique(region))])

# data frame to store results
randMPAs <- as.data.table(expand.grid(region = regs, tempstep = temps, sizestep = sizes, repnum = 1:nreps, temprng = NA_real_,
                                      size = NA_real_, meanturnIndiv = NA_real_, sdturnIndiv = NA_real_, netwrkturn = NA_real_,
                                      sdnetwrkturn = NA_real_))

# a slow loop, especially on higher values of j and k
for(i in 1:length(regs)){
	print(regs[i])

	# set up the set of planning units (lat, lon, sbt)
	punits <- clim[region == regs[i],]

	tx <- diff(range(punits$sbt, na.rm = TRUE)) # the range of temperatures in the region
	nu <- sum(!duplicated(punits[, .(lat, lon)])) # the number of planning units
	if(nu != nrow(punits)) stop(paste0('i=', i, '. Duplicated entries in punits'))

	# loads presence/absence data for each species/model/rcp
	if(regs[i] %in% c('ebs', 'goa', 'bc', 'wc')) ocean <- 'Pac'
	if(regs[i] %in% c('gmex', 'seus', 'neus', 'maritime', 'newf')) ocean <- 'Atl'
	for (j in 1:length(rcps)){
	    for(k in 1:length(periods)){
	        cat(paste0('\tLoading rcp', rcps[j], ' ocean', ocean, ' period', periods[k], '\n'))
	        prestemp <- fread(cmd = paste0('gunzip -c temp/presmap_', ocean, '_rcp', rcps[j], '_', periods[k], '.csv.gz'), drop = 1)

	        if(j == 1 & k == 1){
	            presmap <- prestemp
	        } else {
	            presmap <- rbind(presmap, prestemp)
	        }
	    }
	}
    rm(prestemp)

	# create and evaluate the random networks
	for(j in 1:length(temps)){ # for each temperature step
		cat(paste('\nj=',j, sep=''))

	    for(k in 1:length(sizes)){ # for each size step
			cat(paste('\tk=',k,': ', sep=''))

			for(r in 1:nreps){ # for each repeat
				cat(paste('r=',r,' '))

				# randomly designate a first planning unit as MPA
				punits[, sel := FALSE]
				punits[sample(1:.N,1) , sel := TRUE] # pick a first MPA
				ft <- punits[sel == TRUE, sbt] # the temperature

				# calculate nearby planning units from first MPA (based on temp extent)
				punits[, nearby := FALSE] # initialize "nearby" flag (within a certain fraction of lat extent)
				punits[abs(sbt-ft)/tx <= temps[j], nearby := TRUE] # mark some as nearby in temperature space

				# add more MPAs until size criterion met or all nearby units selected
				fracwholearea <- 1/nu
				fracnearbyarea <- 1/sum(punits$nearby)
				while(fracwholearea <= sizes[k] & fracnearbyarea <= 1 & sum(punits$nearby & !punits$sel)>0 ) {
					newunit <- punits[, sample(which(nearby & !sel), 1)] # select a new unit
					punits[newunit, sel:= TRUE] # assign as selected
					fracwholearea <- sum(punits$sel)/nu
					fracnearbyarea <- sum(punits$sel)/sum(punits$nearby)
					minsbtsel <- punits[sel == TRUE, min(sbt)]
					maxsbtsel <- punits[sel == TRUE, max(sbt)]
					punits[, nearby := ((sbt - minsbtsel)/tx <= temps[j] & sbt >= minsbtsel) | ((maxsbtsel - sbt)/tx < temps[j] & sbt <= maxsbtsel)] # measure nearby from the min temp if new potential temps are > min, and measure from max temp if new potential temps are < max
				}

				# merge selected MPA list with species data
				thesesppbymod <- merge(punits[sel == TRUE, .(lat, lon)], presmap, by.x = c('lat', 'lon'), by.y = c('latgrid', 'longrid'), all.x = TRUE)

				# calculate change in poccur for each species/model/rcp/grid
				thesesppbymod <- dcast(thesesppbymod, spp + rcp + model + lat + lon ~ year_range, value.var = 'poccur') # reshape to wide format
                thesesppbymod[, dpoccur := get(periods[2]) - get(periods[1])] # calculate the change
                thesesppbymod[, pshared := get(periods[2]) * get(periods[1])] # calculate the probability of being shared

				# basic calcs for this random network
				ind <- randMPAs[, which(region == regs[i] & tempstep == temps[j] & sizestep == sizes[k] & repnum == r)]
				randMPAs[ind, temprng := punits[sel == TRUE, (max(sbt)-min(sbt))/tx]]
				randMPAs[ind, size := punits[, sum(sel)/nu]]

				# evaluate ecological turnover for each individual MPA
				mpatempstats <- thesesppbymod[, .(nshared = sum(pshared)), by = .(lat, lon, rcp, model)]
				mpatempstats <- merge(mpatempstats, thesesppbymod[dpoccur > 0, .(ngained = sum(dpoccur)), by = .(lat, lon, rcp, model)])
				mpatempstats <- merge(mpatempstats, thesesppbymod[dpoccur < 0, .(nlost = - sum(dpoccur)), by = .(lat, lon, rcp, model)])
				mpatempstats[, beta_sor := 1 - 2*nshared / (2*nshared + nlost + ngained)] # sorenson dissimilarity
				randMPAs$meanturnIndiv[ind] <- mpatempstats[, mean(beta_sor)]
				randMPAs$sdturnIndiv[ind] <- mpatempstats[, .(beta_sor = mean(beta_sor)), by = .(lat, lon)][, sd(beta_sor)] # sd across models and rcps

				# ecological turnover for the entire network
                thesesppbymodnet <- thesesppbymod[, .(pinit = 1 - prod(1 - get(periods[1])), pfinal = 1 - prod(1 - get(periods[2]))), by = .(spp, rcp, model)] # aggregate probability for each species across the full network at each time period
                thesesppbymodnet[, dpoccur := pfinal - pinit] # calculate the change
                thesesppbymodnet[, pshared := pfinal * pinit] # calculate the probability of being shared
                mpatempstatsnet <- thesesppbymodnet[, .(nshared = sum(pshared)), by = .(rcp, model)]
                mpatempstatsnet <- merge(mpatempstatsnet, thesesppbymodnet[dpoccur > 0, .(ngained = sum(dpoccur)), by = .(rcp, model)])
                mpatempstatsnet <- merge(mpatempstatsnet, thesesppbymodnet[dpoccur < 0, .(nlost = - sum(dpoccur)), by = .(rcp, model)])
                mpatempstatsnet[, beta_sor := 1 - 2*nshared / (2*nshared + nlost + ngained)] # sorenson dissimilarity
                randMPAs$netwrkturn[ind] <- mpatempstatsnet[, mean(beta_sor)]
                randMPAs$sdnetwrkturn[ind] <- mpatempstatsnet[, sd(beta_sor)] # sd across models and rcps

			}
		}
	}
	cat('\n')
}

# write out
write.csv(randMPAs, file='output/randMPAs_byBT.csv')


library (gsubfn)
setwd('/src/r')
source('Melting.r')
source('Refreezing.r')
source('Snowaccumulation.r')
source('Snowdensity.r')
source('Snowdepth.r')
source('Snowdepthtrans.r')
source('Snowdry.r')
source('Snowmelt.r')
source('Snowwet.r')
source('Tavg.r')
source('Tempmax.r')
source('Tempmin.r')
source('Preciprec.r')

model_snow <- function (jul = 0,
         Tmf = 0.0,
         SWrf = 0.0,
         tsmax = 0.0,
         precip = 0.0,
         DKmax = 0.0,
         trmax = 0.0,
         tmax = 0.0,
         ps_t1 = 0.0,
         Sdepth_t1 = 0.0,
         Sdry_t1 = 0.0,
         Swet_t1 = 0.0,
         rho = 100.0,
         Kmin = 0.0,
         Pns = 100.0,
         tmaxseuil = 0.0,
         tminseuil = 0.0,
         tmin = 0.0,
         prof = 0.0,
         E = 0.0){
    #'- Name: Snow -Version: 1.0, -Time step: 1
    #'- Description:
    #'            * Title: Snow model
    #'            * Author: STICS
    #'            * Reference: Snow paper
    #'            * Institution: STICS
    #'            * Abstract: Snow
    #'- inputs:
    #'            * name: jul
    #'                          ** description : current day of year for the calculation
    #'                          ** inputtype : variable
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : INT
    #'                          ** default : 0
    #'                          ** min : 0
    #'                          ** max : 366
    #'                          ** unit : d
    #'                          ** uri :
    #'            * name: Tmf
    #'                          ** description : threshold temperature for snow melting
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: SWrf
    #'                          ** description : degree-day temperature index for refreezing
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : mmW/degC/d
    #'                          ** uri :
    #'            * name: tsmax
    #'                          ** description : maximum daily air temperature (tmax) below which all precipitation is assumed to be snow
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 1000
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: precip
    #'                          ** description : current precipitation
    #'                          ** inputtype : variable
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : mmW
    #'                          ** uri :
    #'            * name: DKmax
    #'                          ** description : difference between the maximum and the minimum melting rates
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : mmW/degC/d
    #'                          ** uri :
    #'            * name: trmax
    #'                          ** description : tmax above which all precipitation is assumed to be rain
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: tmax
    #'                          ** description : current maximum air temperature
    #'                          ** inputtype : variable
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: ps_t1
    #'                          ** description : density of snow cover in previous day
    #'                          ** inputtype : variable
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 100.0
    #'                          ** unit : kg/m**3
    #'                          ** uri :
    #'            * name: Sdepth_t1
    #'                          ** description : snow cover depth Calculation in previous day
    #'                          ** inputtype : variable
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : m
    #'                          ** uri :
    #'            * name: Sdry_t1
    #'                          ** description : water in solid state in the snow cover in previous day
    #'                          ** inputtype : variable
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW
    #'                          ** uri :
    #'            * name: Swet_t1
    #'                          ** description : water in liquid state in the snow cover in previous day
    #'                          ** inputtype : variable
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 100.0
    #'                          ** unit : mmW
    #'                          ** uri :
    #'            * name: rho
    #'                          ** description : The density of the new snow fixed by the user
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 100
    #'                          ** min :
    #'                          ** max :
    #'                          ** unit : kg/m**3
    #'                          ** uri :
    #'            * name: Kmin
    #'                          ** description : minimum melting rate on 21 December
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : mmW/degC/d
    #'                          ** uri :
    #'            * name: Pns
    #'                          ** description : density of the new snow
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 100.0
    #'                          ** min :
    #'                          ** max :
    #'                          ** unit : cm/m
    #'                          ** uri :
    #'            * name: tmaxseuil
    #'                          ** description : maximum temperature when snow cover is higher than prof
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min :
    #'                          ** max :
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: tminseuil
    #'                          ** description : minimum temperature when snow cover is higher than prof
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 5000.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: tmin
    #'                          ** description : current minimum air temperature
    #'                          ** inputtype : variable
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 100.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: prof
    #'                          ** description : snow cover threshold for snow insulation
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 1000
    #'                          ** unit : cm
    #'                          ** uri :
    #'            * name: E
    #'                          ** description : snow compaction parameter
    #'                          ** inputtype : parameter
    #'                          ** parametercategory : constant
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min :
    #'                          ** max :
    #'                          ** unit : mm/mm/d
    #'                          ** uri :
    #'- outputs:
    #'            * name: M
    #'                          ** description : snow in the process of melting
    #'                          ** variablecategory : rate
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW/d
    #'                          ** uri :
    #'            * name: tminrec
    #'                          ** description : recalculated minimum temperature
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: Sdepth
    #'                          ** description : snow cover depth Calculation
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : m
    #'                          ** uri :
    #'            * name: Sdry
    #'                          ** description : water in solid state in the snow cover
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW
    #'                          ** uri :
    #'            * name: Snowaccu
    #'                          ** description : snowfall accumulation
    #'                          ** variablecategory : rate
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW/d
    #'                          ** uri :
    #'            * name: ps
    #'                          ** description : density of snow cover
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : kg/m**3
    #'                          ** uri :
    #'            * name: Swet
    #'                          ** description : water in liquid state in the snow cover
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW
    #'                          ** uri :
    #'            * name: tavg
    #'                          ** description : mean temperature
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: Mrf
    #'                          ** description : liquid water in the snow cover in the process of refreezing
    #'                          ** variablecategory : rate
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW/d
    #'                          ** uri :
    #'            * name: tmaxrec
    #'                          ** description : recalculated maximum temperature
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: preciprec
    #'                          ** description : recalculated precipitation
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : mmW
    #'                          ** uri :
    #'            * name: Snowmelt
    #'                          ** description : Snow melt
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : m
    #'                          ** uri :
    #'            * name: Sdepth_cm
    #'                          ** description : snow cover depth in cm
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : cm
    #'                          ** uri :
    Snowaccu <- model_snowaccumulation(tsmax, tmax, trmax, precip)
    ps <- model_snowdensity(ps_t1, Sdepth_t1, Sdry_t1, Swet_t1)
    tavg <- model_tavg(tmin, tmax)
    M <- model_melting(jul, Tmf, DKmax, Kmin, tavg)
    Mrf <- model_refreezing(tavg, Tmf, SWrf)
    Snowmelt <- model_snowmelt(ps, M)
    Sdry <- model_snowdry(Sdry_t1, Snowaccu, Mrf, M)
    Sdepth <- model_snowdepth(Snowmelt, Sdepth_t1, Snowaccu, E, rho)
    Swet <- model_snowwet(Swet_t1, precip, Snowaccu, Mrf, M, Sdry)
    Sdepth_cm <- model_snowdepthtrans(Sdepth, Pns)
    preciprec <- model_preciprec(Sdry_t1, Sdry, Swet, Swet_t1, Sdepth_t1, Sdepth, Mrf, precip, Snowaccu, rho)
    tminrec <- model_tempmin(Sdepth_cm, prof, tmin, tminseuil, tmaxseuil)
    tmaxrec <- model_tempmax(Sdepth_cm, prof, tmax, tminseuil, tmaxseuil)
    return (list ("M" = M,"tminrec" = tminrec,"Sdepth" = Sdepth,"Sdry" = Sdry,"Snowaccu" = Snowaccu,"ps" = ps,"Swet" = Swet,"tavg" = tavg,"Mrf" = Mrf,"tmaxrec" = tmaxrec,"preciprec" = preciprec,"Snowmelt" = Snowmelt,"Sdepth_cm" = Sdepth_cm))
}


#script to Inverse-Manhattan-Block distance results (i.e., inertia model)
#Eric Schulz and Charley Wu July 2017

#house keeping
rm(list=ls())

#load packages
packages <- c('plyr', 'ggplot2', 'jsonlite', 'MASS', 'gridExtra')
lapply(packages, require, character.only = TRUE)

#read in data
dat<-read.csv("ExperimentData/experimentData2D.csv")

##############################################################################################################
# IMPORT DATA
##############################################################################################################
#dummy data frame
d<-data.frame(id=numeric(), trial=numeric(), x=numeric(), y=numeric(),
              z=numeric(), zmax=numeric(), kernel=numeric(), scenario=numeric(),
              horizon=numeric(), round=numeric())

#loop through data
for (i in 1:nrow(dat)){
  #read JSON of search history
  dfinal <-fromJSON(as.character(dat$searchHistory[i]))
  #sampled x value
  x<-unlist(dfinal$xcollect)
  #sampled y value
  y<-unlist(dfinal$ycollect)
  #sampled z value
  z<-unlist(dfinal$zcollect)
  #length
  len<-sapply(dfinal[1]$xcollect, length)
  #trial 1:20 or 1:40
  trial<-c(1:len[1],1:len[2],1:len[3],1:len[4])
  #round, 1:4
  round<-rep(1:8, len)
  #horizon, 20 or 40
  horizon<-rep(len-1, len)
  #maximum value or cumulative
  scenario<-rep(dat$scenario[i], sum(len))
  #smoothness
  kernel<-rep(dat$kernel[i], sum(len))
  #id number
  id<-rep(i, sum(len))
  #zmax<-unlist(sapply(dfinal$zcollect, maxton))
  #dummy frame
  dummy<-data.frame(id, trial, x, y, z, kernel, scenario, horizon, round)
  #bind them together
  d<-rbind(d, dummy)
}

#create a unique listing for each space in the grid
allopts<-expand.grid(0:10, 0:10)
d$chosen<--99
for (i in 1:nrow(d)){ #loop through data and assign the unique listing from allopts to data$chosen based on the chosen x and y values
  d$chosen[i]<-which(d$x[i]==allopts$Var1 & d$y[i]==allopts$Var2)
}

#create an overall id, unique for each subject for each round
d$overall<-1:nrow(d)-with(d, ave(id, paste(id, round), FUN = seq_along))
d<-transform(d,overall=as.numeric(factor(overall)))
d$round <- factor(d$round) #convert round into factor

##############################################################################################################
# COMPUTE MANHATTAN BLOCK DISTANCE
##############################################################################################################
computeIMD <- function(){
  cand<-expand.grid(0:10, 0:10) #candidates
  names(cand)<-c("x","y")
  k<-1 #counter
  #loop through subjects
  for (h in 1:max(d$id)){
    dsub<-subset(d, id==h)
    #loop through rounds
    for (i in 1:8){
      dblock<-subset(dsub, round==i)
      dist<-matrix(0, nrow=121, ncol=nrow(dblock)-1)
      #loop through trials
      for (j in 1:(nrow(dblock)-1)){
        dist[,j]<-abs(cand$x-dblock$x[j])+abs(cand$y-dblock$y[j])
      }
      dist[dist==0]<-1
      dist<-dist^-1
      write.table(dist, file = paste0("blockdistance/block", k, ".csv"), sep = ",", col.names = FALSE, row.names = FALSE)
      k<-k+1
    }
  }
}

#computeIMD()

##############################################################################################################
# ESTIMATE MODEL FIT
##############################################################################################################
source('Models.R')

inertiaFit<-function(participant, tau){
  subjD <- subset(d, id==participant)
  #Vector to store negative log likelihods
  nLL <- rep(0,length(8))
  for (r in 1:8){ #Begin looping through each round
    #subset of data for round r
    roundD <- subset(subjD, round==r)
    #is this round a short or long horizon?
    horizon = roundD$horizon[1]
    #Observations of subject choice behavior
    chosen <- roundD$chosen
    chosen <- chosen[2:length(chosen)] # trim first observation, since it wasn't a choice but a randomly revealed tile
    #Utilties of each choice
    utilities <- NULL
    #loop through observations
    for (i in 1:horizon){ #skip the last observation, because no choice was made based on that information
      #Inverse Manhatten distance
      out <- inertia(subjD$id[1], i, as.integer(r))
      utilityVec <- ucb(out, c(0)) #use UCB as a proxy, where beta=0
      utilities <- rbind(utilities, utilityVec) # build horizon_length x 121 matrix, where each row holds the utilities of each choice at each decision time in the search horizon
    }
    #Softmax rule
    utilities <- utilities/max(utilities) #scale to max value of one
    p <- exp(utilities/tau)
    p <- p/rowSums(p)
    #avoid underflow by setting a floor and a ceiling
    p <- (pmax(p, 0.00001))
    p <- (pmin(p, 0.99999))
    #Calculate Negative log likelihood
    nLL[r] <- -sum(log(p[cbind(c(1:horizon),chosen)]))
  }#end loop through rounds
  return(sum(nLL))  #Return negative log likelihoods of all observations
}

inertiaNLLs <- NULL
d$inertia <- 0
for (i in 1:80){
  inertiaNLLs[i] <- inertiaFit(i, 1)
  d$inertia[d$id==i]  <- rep(inertiaNLLs[i], length(d$inertia[d$id==i]))
}


for(i in 1:10)
{
   cat(i)
   if(i %% 5 == 0)
   {
      cat("\n")
      next
   }
   cat(", ")
}


x<-c(0.119,0.2238,0.2551,0.3404,0.4984,0.506,0.5853,0.7513,0.9597)
y<-c(0.6991,0.1493,0.8407,0.5472,0.8909,0.2543,0.1386,0.2575,0.9593)
 y1<-y[order(y)]
x1<-x[order(y)]
m<-matrix(c(as.matrix(x1),as.matrix(y1)),9,2)
M<-data.frame(m)
plot(M)


library(knitr)

png("jennyTest.png")
plot(rnorm(100), main = R.version.string)
dev.off()

png("jennyTest2.png")
plot(cars, main = "just a test")
dev.off()

res  <- imgur_upload("jennyTest.png")
res  # link to original URL of the image
# http://i.imgur.com/XPnYnSl.png
#if (interactive())
#    browseURL(res)

res  <- imgur_upload("jennyTest2.png")
res  # link to original URL of the image
# http://i.imgur.com/FA0rnqY.png
#    browseURL(res)

file.remove(list.files(pattern = "^jennyTest*"))


encoding="utf-8"

library(DESeq)
file="CRPstim.gene.txt"
CountTable = read.table (file,header =T ,row.names = 1 )
condition = factor (c("con","con","con","stim","stim","stim"))
cds = newCountDataSet(CountTable,condition)
cds=estimateSizeFactors(cds)
count_norm = counts(cds,normalized=TRUE)
write.table(count_norm,file="CRPstim_Norm.txt",row.names=TRUE,col.names=TRUE,quote=FALSE,sep="\t")


#My-truth---calculates autofit(p,q)order all value in string/arma models to divide into stationary & non-stat models

rm(list=ls())
library(itsmr)  #adding itsmr package

#pandit <-list.files("K:\\Project_Data_Sagar\\my_truth\\sangram_clipso\\")  #before
pandit<-read.table("K:\\Project_Data_Sagar\\Halwa\\BADMASHI\\my_truth\\Model\\ARMA\\my_truth_autofit_arma_stationary.txt",skip=1)
pandit<-as.character(pandit$V1)   #taking only stationary pdf ids

naringi_firangi<-NULL #complete row information for Stationary model
bunty_bubly<-NULL  #for taking zero p & q
kuvari_dulhan<-NULL #takes non-stat ids

for (sangeet in pandit){

straussberg<-substr(sangeet,1,nchar(sangeet)-4) #file name
compendium<- read.table(paste("K:\\Project_Data_Sagar\\my_truth\\sangram_clipso\\",sangeet,sep=""),skip=1)
print(paste("Reading-------------------------------->",sangeet))

#autofit(arma)model  & checking for non stationarity
 j<-NULL
 red_money<-NULL
 j<-tryCatch(red_money<-autofit(ts(compendium$V4)),error=function(e)e )   #autofit(arma)model (max likelihood method)

 if(inherits(j,"simpleError")){ kuvari_dulhan<-append(kuvari_dulhan,straussberg);print(paste("Non-Stationary-------------------------->",straussberg))}else{

#checking p & q (both)zero
if(red_money$phi[1]==0 && red_money$theta[1]==0 ){
  bunty_bubly<-append(bunty_bubly,straussberg)  #p,q not zero else
   } else{

if(length(red_money$phi)>1){p_tunar<-paste(red_money$phi,collapse=" ");autofit_ar_p<-length(red_money$phi) }  else if(red_money$phi==0){p_tunar<-0;autofit_ar_p<-0} else{p_tunar<-red_money$phi;autofit_ar_p<-length(red_money$phi)}       #autoregressive p value & order  #to decode jk<-strsplit(tunar," ")  & pal<-jk[[1]][1]
if(length(red_money$theta)>1){q_funar<-paste(red_money$theta,collapse=" ");autofit_ma_q<-length(red_money$theta)}  else if(red_money$theta==0){q_funar<-0;autofit_ma_q<-0} else{q_funar<-red_money$theta;autofit_ma_q<-length(red_money$theta)}   #moving average q value & order

autofit_aicc<-red_money$aicc   #aicc
autofit_sigma2<-red_money$sigma2  # sigma2

 #joining single line
 bumro<-cbind(sangeet,autofit_ar_p,p_tunar,autofit_ma_q,q_funar,autofit_sigma2,autofit_aicc,deparse.level=0)
 naringi_firangi<-rbind(naringi_firangi,bumro)
            } #else,checking p,q -->zero

}# else non-stat

}  #last for  4 file iterating

#writnig only stationary model
write.table(naringi_firangi,"K:\\Project_Data_Sagar\\Halwa\\BADMASHI\\my_truth\\Model\\ARMA\\my_truth_autofit_arma_stationary_after_kamal.txt",col.names=c("PDB_file","Autof_p_order","Autof_ar_p_value","Autof_q_order","AutoF_ma_q_value","Autof_sigma2","AutoF_aicc"),row.names=F)

#zero p & q models
write.table(bunty_bubly,"K:\\Project_Data_Sagar\\Halwa\\BADMASHI\\my_truth\\Model\\ARMA\\my_truth_autofit_arma_stat_p_q_zero_after_kamal.txt",col.names="zero p & q models",row.names=F)

#Non-statioary models list
if(is.null(kuvari_dulhan)){write.table("Your data has NO-non-stationary items","K:\\Project_Data_Sagar\\Halwa\\BADMASHI\\my_truth\\Model\\ARMA\\my_truth_autofit_arma_non_stat_after_kamal.txt",col.names=F,row.names=F)}else{
write.table(kuvari_dulhan,"K:\\Project_Data_Sagar\\Halwa\\BADMASHI\\my_truth\\Model\\ARMA\\my_truth_autofit_arma_non_stat_after_kamal.txt",col.names="MY-truth_Non-stat_ARMA",row.names=F)  }


## Trabajo final MAPP Otoño. Métodos cuantitativos.
## Integrantes:
## Guadalupe Álvarez
## Ángel Carrillo
## Eduardo Muñiz

Sys.setlocale("LC_ALL", "es_ES.UTF-8") # Cambiar locale para prevenir problemas con caracteres especiales
options(scipen=999) # Prevenir notación científica
rm(list=ls()) #Limpia todas las variables y objetos creados

##### Paquetería ----
library(tidyverse)
library(ggplot2)
library(ggcorrplot)
library(ggthemes)

library(cluster)
library(dplyr)
library(pacman)
library(factoextra)
library(dendextend)
library(purrr)

##### Base de datos ----
computoeinegi <- read.csv("2021 computoeinegi.csv")
str(computoeinegi)
head(computoeinegi)
# View(computoeinegi)

##### Estadística descriptiva ----

gr_participacion <- ggplot( computoeinegi,
                   aes(x=distrito , y=participacion) )+
              geom_point() +
              labs(title="Participación electoral",
                  subtitle="Proceso Electoral Federal 2021.",
                  x="Distrito electoral federal",
                  y="Porcentaje de participación",
                  caption="Elaboración propia con datos de INE(2021).") +
              theme_economist()+
              theme(axis.text.x=element_text(angle=50,size=12))

plot(gr_participacion)


# Use central baltic cod consum data to find a general Consum=a(q)* W^(2/3)
 X11()
 dat<-Read.summary.data(extend=F,read.init.function=F)
 dat<-subset(dat,Age>=1 & Species=='Cod')
 dat$a<-dat$ration/(dat$west^0.66)
 plot(dat$Year,dat$a,col=dat$Quarter)
 plot(dat$Age,dat$a,col=dat$Quarter)

 ftable(round(tapply(dat$a,list(dat$Age,dat$Quarter),mean),2))
  tapply(dat$a,list(dat$Quarter),mean)


#' @export
ECDF.strata <- function (object, Plot = TRUE, ...) {
    if (!inherits(object, "strata"))
        stop("Not a legitimate strata object")
    Whi <- vector("list", max.str <- length(object$yhi))
    wh <- object$Wh/object$nh
    for (i in 1:max.str) {
        Whi[[i]] <- rep(wh[i], object$nh[i])
    }
    yhi <- as.vector(unlist(object$yhi))
    Whi <- as.vector(unlist(Whi))
    yhi.ord <- order(yhi)
    results <- list(x = yhi[yhi.ord], y = cumsum(Whi[yhi.ord]))
    if (Plot) {
        ECDF.strata.plot(results, ...)
        title(main = "Empirical Cumulative Distribution")
        invisible(results)
    }
    else results
}


library(Rcpp)
library(devtools)
library(rEDM)
library(viridis)

### Data preparation
setwd(paste0(wd, "output"))

species = c("Clupea harengus", "Gadus morhua", "Melanogrammus aeglefinus",
            "Merlangius merlangus", "Pleuronectes platessa", "Pollachius virens",
            "Scomber scombrus", "Sprattus sprattus", "Trisopterus esmarkii")

# load data
EDM_list = list()
for (i in 1:length(species)){
    EDM_list[[i]] = list()
    EDM_list[[i]]$species = species[i]
    EDM_list[[i]]$data = read.csv(paste0(species[i], ".csv"), header = TRUE)
}
names(EDM_list) = species

# standarization (data)
EDM_list = lapply(EDM_list, FUN = function(item){
    item$data_std = cbind(item$data[, c(1,2)], scale(item$data[, -c(1,2)]))

    return(item)
})

# change column name
EDM_list = lapply(EDM_list, function(item){
    var.name = c("Year", "Quarter", "CV.CPUE", "AgeDiversity", "Abundance",
                 "AMO", "SBT", "CVofSBT", "SST", "CVofSST")
    names(item$data) = var.name
    names(item$data_std) = var.name

    return(item)
})

# drop discontinuous data (Pleuronectes platessa has missing year)
EDM_list$`Pleuronectes platessa`$data_std = EDM_list$`Pleuronectes platessa`$data_std[19:48, ]

# load fishing mortality data
setwd(paste0(wd, "output"))
fishingM = read.csv("fishingM.csv", header=TRUE)
fishingM_wo_species = subset(fishingM, select=-c(Species))
fishingM_wo_species = split(fishingM_wo_species, f=fishingM$Species)

## convert quarterly data to yearly data to meet with fishing mortality data
# a function to compute mean value for each year
compute_mean_per_year = function(data){
    data_wo_year = subset(data, select=-c(Year, Quarter))
    mean_per_year = aggregate(data_wo_year, by=list(Year=data$Year), FUN=mean)
    return(mean_per_year)
}

# apply above function to each item (species) in list
EDM_list = lapply(EDM_list, FUN=function(item){
    data = item$data
    data_per_year = compute_mean_per_year(data)
    item$data_per_year = data_per_year
    return(item)
})

# combine data with fishing mortality data
for (i in 1:length(EDM_list)){
    result = merge(EDM_list[[i]]$data_per_year, fishingM_wo_species[[i]], by=c("Year"))
    EDM_list[[i]]$data_per_year = result
}

# standarization (data_per_year)
EDM_list = lapply(EDM_list, FUN = function(item){
    item$data_per_year = cbind(item$data_per_year[c(1)],
                               scale(item$data_per_year[, -c(1)]))
    return(item)
})

rm(result)
rm(fishingM)
rm(fishingM_wo_species)

## detrend
# lienar regression to remove significant trend
detrend_sig = function(series){
    data = data.frame(x=1:length(series), y=series)
    fit = lm(y~x, data=data)
    fit_summary = summary(fit)
    p_value = fit_summary$coefficient[, 4]['x']

    if (p_value < 0.05){
        return(as.numeric(series - fit$fitted.values))
    } else {
        return(series)
    }
}

### Simplex projection
# a function returning all local peaks
# (will be applied to get all local optimal embedding dimensions)
detectPeak = function(data){
    n = length(data)
    peaks = c()
    rho = c()
    for (idx in 2:(n-1)){ # from E=2
        if ((data[idx-1] < data[idx]) & (data[idx+1] < data[idx])){
            peaks = c(peaks, idx)
            rho = c(rho, data[idx])}
    }
    output = data.frame(peaks, rho)

    if (nrow(output) < 1){
        rho = max(data[-1]) # ignore E=1
        peaks = which(data == rho)
        return(data.frame(peaks, rho))
    } else {
        return(output[order(output$rho, decreasing = TRUE), ])
    }
}

# a function using simplex projection to determine embedding dimension for each variable
computeEmbedding = function(data, show_result=TRUE){
    # create a list to record embedding dimensions
    dim.list = list()

    # determine embedding dimension of each variables
    for (column in colnames(data)){
        output <- simplex(data[[column]], E = 1:10, tau = 1, tp = 1) # embedding dimension
        if (show_result){
            plot(output$E, output$rho, type = "l", main = column, lwd = 2,
                 xlab = "Embedding Dimension (E)", ylab = "Forecast Skill (rho)")
        }
        dim.list[[column]] = detectPeak(output$rho)
        #dim.list[[column]] = output[, c("E", "rho")][order(output$rho, decreasing = TRUE), ]
    }

    return(dim.list)
}

### CCM
library(data.table)

# a function using CCM to determine causal variables (including lagged terms) of spatial CV
determineCausality = function(data, dim.list, species, lags=8, num_samples=100, seed=1234){
    cols = c('length', 'lib.size', 'E', 'library', 'target', 'tar.lag',
             'rho', 'sd.rho', 'kendall.tau', 'significance')
    ccm_var = data.frame(matrix(0, length(lags:0), length(cols)))  # ccm results
    colnames(ccm_var) = cols

    output = data.frame(matrix(0, nrow = 0, ncol = length(cols)))  # ccm results for all variables
    colnames(output) = cols

    library_var = colnames(data)[1]
    max_time = dim(data)[1]  # number of data points
    for (idx in 2:length(data)){
        target_var = colnames(data)[idx]  # target variable
        E = dim.list[[target_var]]$peak[1]  # E of target variable

        for (lag in -lags:0){
            cv_x <- ccm(data, E = E, tp = lag, lib_sizes = c(seq(E, max_time, 3), max_time),
                        lib_column = 1, target_column = idx, num_samples = num_samples, RNGseed=seed)
            cv_x_m <- data.frame(ccm_means(cv_x), sd.rho = with(cv_x, tapply(rho, lib_size, sd)))

            n = dim(cv_x_m)[1]  # last row: ccm results with maximal library size

            current_row = lag + lags + 1
            ccm_var[current_row, "length"] = max_time
            ccm_var[current_row, "lib.size"] = cv_x_m$lib_size[n]
            ccm_var[current_row, "E"] = E
            ccm_var[current_row, "library"] = library_var
            ccm_var[current_row, "target"] = names(data)[idx]
            ccm_var[current_row, "tar.lag"] = lag
            ccm_var[current_row, "rho"] = cv_x_m$rho[n]
            ccm_var[current_row, "sd.rho"] = cv_x_m$sd.rho[n]
            ccm_var[current_row, "kendall.tau"] = cor.test(cv_x_m$lib_size, cv_x_m$rho,
                                                           alternative = 'greater', method = 'kendall')$p.value
            ccm_var[current_row, "significance"] = t.test(subset(cv_x, subset = lib_size==cv_x_m$lib_size[n])$rho,
                                                          alternative = 'greater')$p.value
        }
        output = rbind(output, ccm_var)
    }

    return(output)
}

### S-map
## generate a data frame corresponding to lagged variables for S-map analysis
generateSmapData = function(item, data, lib_var, is_full=FALSE){
    num_Smap_model = length(item$E_feasible$peaks)
    if (num_Smap_model < 1){
        item$Smap1 = NA
        return(item)
    }

    name_Smap_model = paste0("Smap", 1:num_Smap_model)
    num_sample = dim(data)[1]
    num_variable = item$E_feasible$peaks

    ccm_result = item$ccm_most_significant
    ccm_result = ccm_result[order(ccm_result$rho, decreasing = TRUE), ]

    for (i in 1:num_Smap_model){
        item[[name_Smap_model[i]]] = list()
        item[[name_Smap_model[i]]]$data = data.frame(matrix(0, nrow = num_sample, ncol = 0))
        item[[name_Smap_model[i]]]$data[, lib_var] = data[lib_var]

        for (idx_var in 1:(num_variable[i]-1)){
            if (is_full){
                vars = as.character(ccm_result$target[idx_var])
                item[[name_Smap_model[i]]]$data[, vars] = data[, vars]
            } else {
                lags = abs(ccm_result$tar.lag[idx_var])
                vars = as.character(ccm_result$target[idx_var])
                item[[name_Smap_model[i]]]$data[, vars] = c(rep(NA,lags), data[, vars][1:(num_sample-lags)])
            }
        }
    }

    return(item)
}

# function to perform S-map analysis
performSmap = function(data_for_smap){
    data = data.frame(data_for_smap)

    # determine the optimal theta (non-linearity parameter)
    theta = c(0, 1e-04, 3e-04, 0.001, 0.003, 0.01,
              0.03, 0.1, 0.3, 0.5, 0.75, 1, 1.5, 2, 3, 4, 6, 8)
    rho.theta = data.frame(matrix(0, length(theta), 2))
    colnames(rho.theta) = c('theta', 'rho')
    rho.theta[, 'theta'] = theta

    # compute rho for each S-map model with different theta
    n_theta = length(theta)
    for (i in 1:n_theta){
        block_lnlp_output <- block_lnlp(
            data, columns = c(1:dim(data)[2]), target_column = 1, tp = 1,
            method = "s-map", num_neighbors = 0, stats_only = F,
            theta = rho.theta[i, 'theta'], save_smap_coefficients = T
        )
        rho.theta[i, "rho"] = block_lnlp_output$rho
    }
    theta.opt = rho.theta$theta[which.max(rho.theta$rho)]

    block_lnlp_output <- block_lnlp(
        data, columns = c(1:dim(data)[2]), target_column = 1, tp = 1,
        method = "s-map", num_neighbors = 0, stats_only = F,
        theta = theta.opt, save_smap_coefficients = T
    )

    # The first E columns are for the E lags or causal variables,
    # while the (E+1)th column is the constant
    coeff = data.frame(block_lnlp_output$smap_coefficients[[1]])  # s-map coefficient
    colnames(coeff) = c(colnames(data), "Constant")

    rho = block_lnlp_output$rho

    # test on the significance of rho
    n_pred = block_lnlp_output$num_pred
    t = rho*sqrt(n_pred-2)/sqrt(1-rho^2)
    if (t >= 0){
        pvalue = 1 - pt(t, df = n_pred-2)
    } else {
        pvalue = pt(t, df = n_pred-2)
    }

    theta = round(theta.opt, 2)

    return(list(coefficients = coeff, rho = rho, pvalue = pvalue, theta = theta))
}

## plot S-map coefficients
# give each variable a unique color and shape
# variable: c('F', 'spatial CV', 'age diversity','abundance',
#             'AMO', 'SBT'(SST), 'CV of BT'(CV of SST))
# color: black, yellow, red, green, blue, light blue, purple : c(1,7,2,3,4,5,6)
# cl = c(1,7,2,3,4,5,6,5,6)
# shape: crossbox, cross, circle(s), circle, diamond(s), triangle(s), triangle: c(7,4,21,1,23,24,2)
variables = c("F", "CV.CPUE", "AgeDiversity", "Abundance", "AMO",
              "SBT", "CVofSBT", "SST", "CVofSST")
cl = plasma(7, direction = -1)
cl = c(cl, cl[6:7])
sh = c(7,4,21,1,23,24,2,24,2)


#' Seasonal Factors for Initial Unemployment Claims, weekly (ic, automatic outlier identification, ljung)
#'
#' A time series object with seasonal factors generated for weekly initial unemployment
#' claims from a model that includes automatically identified outliers with a critical value
#' determined by an algorithm developed by Greta Ljung
#'
#' @format A tis time series object from February 1, 2003 to January 30, 2021
"ic_sf_auto_ljung"