sim_plots.Rmd

---
title: "sim_plots"
author: "Raine Detmer"
date: "2023-12-13"
output: html_document
---

README: plot simulation results


```{r, include=FALSE}
library("mgcv")
library("gratia")
library("tidyverse")
#library("ggpubr") # for plotting
#library("quantmod") # for findPeaks function
library("pracma") # for the findpeaks function
#https://search.r-project.org/CRAN/refmans/pracma/html/findpeaks.html
library("data.table") #for between() function

library("beeswarm") # for beeswarm plots in base R

library("tictoc") # for timing


source("load_functions.R") # loads all the functions in the "functions" folder

options(dplyr.summarise.inform = FALSE)# get rid of the "summarize has grouped output by..." warnings


```



# read in results

simulations without any covariate effects:

```{r}

focal_df <- read.csv("simulation outputs/focal_results.csv") # simulations with focal functions and no covariate

#View(focal_df)

focal_df <- focal_df[,-1] # remove index column that got added by read.csv

focal_df <- focal_df %>% mutate(thresh_fraction = thresh_n/ts_length) # fraction of jackknife iterations that detected a threshold

# need to adjust thresh_n_full for the jack_quant significance criteria case: assume that if a threshold wasn't detected in the full data when there was no significance criteria, it wouldn't have been detected if the jack_quant were used as sig criteria either, so change thresh_n_full from NA to 0
focal_df <- focal_df %>% group_by(sim, thresh_method, obs_error, ts_length, thresh_quant, cov_sd, shape) %>% mutate(sum_full = sum(thresh_n_full, na.rm = TRUE)) %>% ungroup() %>% mutate(thresh_n_full=if_else(sig_type=="jack_quant" & sum_full==0, 0, thresh_n_full)) %>% select(-sum_full)

#View(focal_df)

nonfocal_df <- read.csv("simulation outputs/nonfocal_results.csv") # simulations with nonfocal functions
nonfocal_df <- nonfocal_df[,-1]

nonfocal_df <- nonfocal_df %>% mutate(thresh_fraction = thresh_n/ts_length) # fraction of jackknife iterations that detected a threshold

nonfocal_df <- nonfocal_df %>% group_by(sim, thresh_method, obs_error, ts_length, thresh_quant, cov_sd, shape) %>% mutate(sum_full = sum(thresh_n_full, na.rm = TRUE)) %>% ungroup() %>% mutate(thresh_n_full=if_else(sig_type=="jack_quant" & sum_full==0, 0, thresh_n_full)) %>% select(-sum_full)

#View(nonfocal_df)

```


simulatiosn with corvariate effects

```{r}

# cov data

# get the case where cov_sd = 0 from the focal data imported above
cov0_df <- focal_df %>% filter(obs_error==0.0275)

# add column with next best model to this dataframe (to match the with-covariate data below)
cov0_df <- cov0_df %>% mutate(next_mod = if_else(best_mod=="gam", "lm", if_else(best_mod=="lm", "gam", if_else(best_mod=="gam_ns", "lm_ns", "gam_ns")))) %>% relocate(next_mod, .after = best_mod)

## simulations with missing covariate (i.e., not included in estimation models)
lin_covM <- read.csv("simulation outputs/lin_cov.csv") # linear covariate

lin_covM <- lin_covM[,-1]

lin_covM <- lin_covM %>% mutate(next_mod = if_else(best_mod=="gam", "lm", if_else(best_mod=="lm", "gam", if_else(best_mod=="gam_ns", "lm_ns", "gam_ns")))) %>% relocate(next_mod, .after = best_mod)

lin_covM <- lin_covM %>% mutate(thresh_fraction = thresh_n/ts_length) 
lin_covM <- lin_covM %>% group_by(sim, thresh_method, obs_error, ts_length, thresh_quant, cov_sd, shape) %>% mutate(sum_full = sum(thresh_n_full, na.rm = TRUE)) %>% ungroup() %>% mutate(thresh_n_full=if_else(sig_type=="jack_quant" & sum_full==0, 0, thresh_n_full)) %>% select(-sum_full)

lin_covM <- rbind(lin_covM, cov0_df)

lin_covM$cov_type <- rep("linear", length(lin_covM$sim)) # linear cov
lin_covM$cov_inc <- rep("N", length(lin_covM$sim)) # cov wan't included in estimation models
lin_covM$cov_val <- rep(NA, length(lin_covM$sim)) # cov wasn't in estimation models so no value was used in generating predictions from these models

#View(lin_covM)

exp_covM <- read.csv("simulation outputs/exp_cov.csv") # exponential covariate
exp_covM <- exp_covM[,-1]

exp_covM <- exp_covM %>% mutate(next_mod = if_else(best_mod=="gam", "lm", if_else(best_mod=="lm", "gam", if_else(best_mod=="gam_ns", "lm_ns", "gam_ns")))) %>% relocate(next_mod, .after = best_mod)

exp_covM <- exp_covM %>% mutate(thresh_fraction = thresh_n/ts_length) 
exp_covM <- exp_covM %>% group_by(sim, thresh_method, obs_error, ts_length, thresh_quant, cov_sd, shape) %>% mutate(sum_full = sum(thresh_n_full, na.rm = TRUE)) %>% ungroup() %>% mutate(thresh_n_full=if_else(sig_type=="jack_quant" & sum_full==0, 0, thresh_n_full)) %>% select(-sum_full)

exp_covM <- rbind(exp_covM, cov0_df)

exp_covM$cov_type <- rep("exp", length(exp_covM$sim)) # exponential covariate
exp_covM$cov_inc <- rep("N", length(exp_covM$sim))
exp_covM$cov_val <- rep(NA, length(exp_covM$sim))

## simulations with covariate included in estimation models

lin_covI <- read.csv("simulation outputs/lin_cov0.csv")
lin_covI <- lin_covI[,-1]

lin_covI <- lin_covI %>% mutate(thresh_fraction = thresh_n/ts_length) 
lin_covI <- lin_covI %>% group_by(sim, thresh_method, obs_error, ts_length, thresh_quant, cov_sd, shape) %>% mutate(sum_full = sum(thresh_n_full, na.rm = TRUE)) %>% ungroup() %>% mutate(thresh_n_full=if_else(sig_type=="jack_quant" & sum_full==0, 0, thresh_n_full)) %>% select(-sum_full)

lin_covI <- rbind(lin_covI, cov0_df)

lin_covI$cov_type <- rep("linear", length(lin_covI$sim))
lin_covI$cov_inc <- rep("Y", length(lin_covI$sim)) # covariate was included in estimation models
lin_covI$cov_val <- rep(0, length(lin_covI$sim)) # covariate was set to 0 when generating predictions from the estimation models

#View(lin_covI)

exp_covI <- read.csv("simulation outputs/exp_cov0.csv")
exp_covI <- exp_covI[,-1]

exp_covI <- exp_covI %>% mutate(thresh_fraction = thresh_n/ts_length) 
exp_covI <- exp_covI %>% group_by(sim, thresh_method, obs_error, ts_length, thresh_quant, cov_sd, shape) %>% mutate(sum_full = sum(thresh_n_full, na.rm = TRUE)) %>% ungroup() %>% mutate(thresh_n_full=if_else(sig_type=="jack_quant" & sum_full==0, 0, thresh_n_full)) %>% select(-sum_full)

exp_covI <- rbind(exp_covI, cov0_df)

exp_covI$cov_type <- rep("exp", length(exp_covI$sim))
exp_covI$cov_inc <- rep("Y", length(exp_covI$sim))
exp_covI$cov_val <- rep(0, length(exp_covI$sim))


# join altogether
linexp_cov <- rbind(lin_covM, exp_covM, lin_covI, exp_covI)

#View(linexp_cov)


```



# plot pars

```{r}

cov_sd_set2 <- c(0, 0.5, 1) # covariate sd values

# colors for the different threshold definitions
threshcols <- c("purple", "forestgreen", "orange", "dodgerblue")
#threshcols2 <- adjustcolor(threshcols, alpha.f = 0.3)
threshcols2 <- adjustcolor(threshcols, alpha.f = 0.4)
threshcols3 <- adjustcolor(threshcols, alpha.f = 0.3)

# driver values for generating predictions
xvals1 <- seq(from = -3, to = 3, by = 0.01) # needs to be the same as used in simulations

# turn these into a data frame
xdt <- data.frame(
    driver = xvals1
  )

jt_amount <- 0.1 # amount to jitter data points in boxplots

sig_choice <- "none" # significance criteria for which to plot results

sig_thresh <- 0.25 # minimum fraction of jackknife iterations that need to detected a threshold for that simulation to count as having found a threshold

```



# main results

```{r}
# the simulation parameters
obs_set <- c(0.0275, 0.55, 2.75) # sd of observation errors for response
ts_set <- c(15, 25, 35) # time series lengths
quant_set <- c(0.05, 0.25, 0.5) # threshold quantiles

cov_sd_set1 <- c(0) # sd of covariate



```

## estimate bias

plot difference between threshold estimates and true threshold values

### means, all defs

all threshold definitions

```{r}
# 3x3 figure w/ boxplots
boxpos <- c(1:4, 7:10, 13:16)#c(1:4, 7:10) # positions of the boxes

n_adj <- 0.5 # how far from top of box to adjust sample sizes
n_size <- 1 # font size of sample sizes

max_adj <- 0.5 # adjust ymax 

xlab_cex <- 0.8 # size to make x axis labels
col_cex <- 1.2 # font for column labels

plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)

#View(plot_dt)

ymin <- min(plot_dt$thresh_diff, na.rm = T) 
ymax <- max(plot_dt$thresh_diff, na.rm = T)+max_adj 
#yaxt_at <- c(-2, -1, 0, 1, 2)# where to put y axis labels
yaxt_at <- round(seq(from = ymin, to = ymax, by = 1), 0)# where to put y axis labels
ylabs <- seq(from = ymin, to = ymax, by = 1)


pdf("figurepdfs/S_FullDiff.pdf", width = 7.5)
par(mfrow = c(4, 3))
layout(matrix(c(1, 4, 7, 10, 2, 5, 8, 10, 3, 6, 9, 10), nrow = 4, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1, 0.3))
#layout.show(10)
#par(mar=c(0, 1.5, 0.5, 0), oma = c(0, 2, 3, 3))
par(mar=c(0, 1.5, 0.5, 0), oma = c(0, 2, 3, 0.5))
# top row: sigmoidal
plot_dt <- focal_df[which(focal_df$shape=="sigmoidal"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(thresh_method, obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(c("15", "25", "35"), each = 4)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "Time series length", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
text(x = 3.4, y = 3.5, "risk-averse side")
text(x = 3.4, y = -2, "risk-prone side")

for(i in 1:nrow(levels)){ # add jittered points
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$ts_length==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(as.character(obs_set), each = 4)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 3, "Observation error", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$obs_error==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(as.character(quant_set), each = 4)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SG", las = 2)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 3, "Threshold quantile", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# add mini plot showing functional form
#mtext(side = 4, "SG", las = 2, padj = 5)
text(x = boxpos[9]-0.85, y = -1.5, "SG", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)-3]-0.1, ybottom= -2, xright = boxpos[length(boxpos)] -0.6, ytop = -1, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)-3]-0.1, to = boxpos[length(boxpos)] -0.6, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
# y vals for real-size function: make these range from  0 to 1
big_y <- 1/(1 + exp(-6*(big_x-mini_x[length(mini_x)/1.9])))
mini_y <- (-1 + 2)*big_y-2 # now squish the yvalues to fit in the mini plot (which has a yrange of ybottom to ytop in the rect function) and shift them to line up w/ the lower border of the plot
lines(x = mini_x, y = mini_y, type = "l") 


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# middle row: skew
plot_dt <- focal_df[which(focal_df$shape=="skew"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(thresh_method, obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(c("15", "25", "35"), each = 4)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 1, "Time series length", line = 1.2)
mtext(side = 2, "Bias (mean estimate - true threshold)", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$ts_length==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(as.character(obs_set), each = 4)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$obs_error==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(as.character(quant_set), each = 4)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# add mini plot showing functional form
#mtext(side = 4, "SK", las = 2, padj = 5)
text(x = boxpos[9]-0.85, y = -1.75, "SK", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)-3]-0.1, ybottom= -2.25, xright = boxpos[length(boxpos)] -0.6, ytop = -1.25, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)-3]-0.1, to = boxpos[length(boxpos)] -0.6, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-5, to = mini_x[length(mini_x)/2] + 5, length.out = 1000)
big_y <- dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)/max(dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)) # mode is at (shape -1 )*scale
mini_y <- (-1.26 + 2.25)*big_y-2.25
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border



# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# bottom row: hockeystick
plot_dt <- focal_df[which(focal_df$shape=="hockeystick"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
plot_dt <- plot_dt %>% group_by(thresh_method, obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(c("15", "25", "35"), each = 4)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 1, "Time series length", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$ts_length==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(as.character(obs_set), each = 4)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 1, "Observation error", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$obs_error==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 12, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 3)
levels[,2] <- rep(as.character(quant_set), each = 4)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 1, "Threshold quantile", line = 1.2, cex = xlab_cex)
#mtext(side = 4, "HS", las = 2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
text(x = boxpos[9]-0.85, y = -1.75, "HS", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)-3]-0.1, ybottom= -2.25, xright = boxpos[length(boxpos)] -0.6, ytop = -1.25, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)-3]-0.1, to = boxpos[length(boxpos)] -0.6, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-10, to = mini_x[length(mini_x)/2] + 10, length.out = 1000)
big_y <- ifelse(big_x < 0, 0, ifelse(big_x < mini_x[length(mini_x)/2], (0.9-0)/ (mini_x[length(mini_x)/2] - 0) * (big_x - mini_x[length(mini_x)/2]) + 0.9, 0.9))
mini_y <- (-1.25 + 2.25)*big_y-2.25
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border



for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1] & datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# plot 10: dummy plot for legend
plot(0,type='n',axes=FALSE, ann = FALSE)
legend(0.8, 0.2, col = threshcols, pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
text(0.75, -0.4, "Threshold def.", xpd = TRUE)

dev.off()

```



### means, best method

simplified version of the above plot just showing results for the suggested best threshold definition for each functional form

sigmoidal: min(s''(x))

skew: s'(x) = 0

hockeystick: max(|s''(x)|)

```{r}
# 3x3 figure w/ boxplots
boxpos <- c(1, 2, 3)#c(1:4, 7:10) # positions of the boxes

labpos <- c(1, 2, 3) # position of box labels on x axis

n_adj <- 0.5#0.5 # how far from top of box to adjust sample sizes
n_size <- 1 # font size of sample sizes

max_adj <- 0 # adjust ymax 

xlab_cex <- 0.8 # size to make x axis labels
col_cex <- 1.2 # font for column labels


plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
ymin <- min(plot_dt$thresh_diff[which(plot_dt$thresh_method != "zero_d2")], na.rm = T) 
ymax <- max(plot_dt$thresh_diff[which(plot_dt$thresh_method != "zero_d2")], na.rm = T)+max_adj 
#yaxt_at <- c(-2, -1, 0, 1, 2)# where to put y axis labels
yaxt_at <- round(seq(from = ymin, to = ymax, by = 1), 0)# where to put y axis labels
ylabs <- round(seq(from = ymin, to = ymax, by = 1), 0)


pdf("figurepdfs/Best_Diff.pdf", width = 6, height = 6)
par(mfrow = c(4, 3))
layout(matrix(c(1, 4, 7, 10, 2, 5, 8, 10, 3, 6, 9, 10), nrow = 4, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1, 0.3))
#par(mar=c(0.1, 1.5, 0.5, 0), oma = c(1, 2, 1.2, 3))
par(mar=c(0.1, 1.5, 0.5, 0), oma = c(1, 2, 1.2, 0.5))
# top row: sigmoidal
plot_dt <- focal_df[which(focal_df$shape=="sigmoidal"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_method=="min_d2") %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

#View(plot_dt)

levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(c("15", "25", "35"), each = 1)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[2], alpha.f = 0.3), border = threshcols[2], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "Time series length", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#text(x = 2.6, y = 2.8, "risk-averse \nside")
#text(x = 2.6, y = -2, "risk-prone \nside")
text(x = 1.25, y = 2.8, "risk-averse side")
text(x = 1.25, y = -2, "risk-prone side")

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$ts_length==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(thresh_diff ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(obs_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[2], alpha.f = 0.3), border = threshcols[2], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 3, "Observation error", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$obs_error==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(thresh_diff ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(quant_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[2], alpha.f = 0.3), border = threshcols[2], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SG", las = 2)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 3, "Threshold quantile", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
# add mini plot showing functional form
#mtext(side = 4, "SG", las = 2, padj = 5)
text(x = boxpos[length(boxpos)] - 0.25, y = -1.9, "SG", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)], ybottom= -2.3, xright = boxpos[length(boxpos)] + 1.3, ytop = -1.2, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)], to = boxpos[length(boxpos)] + 0.7, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
# y vals for real-size function: make these range from  0 to 1
big_y <- 1/(1 + exp(-6*(big_x-mini_x[length(mini_x)/1.9])))
mini_y <- (-1.25 + 2.3)*big_y-2.3 # now squish the yvalues to fit in the mini plot (which has a yrange of ybottom to ytop in the rect function) and shift them to line up w/ the lower border of the plot
lines(x = mini_x, y = mini_y, type = "l") 

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_quant==as.numeric(levels[i, 2]))]
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# middle row: skew
plot_dt <- focal_df[which(focal_df$shape=="skew"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_method =="zero_d1") %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(c("15", "25", "35"), each = 1)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[3], alpha.f = 0.3), border = threshcols[3], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 1, "Time series length", line = 1.2)
mtext(side = 2, "Bias (mean estimate - true threshold)", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$ts_length==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(thresh_diff ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(obs_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[3], alpha.f = 0.3), border = threshcols[3], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
#mtext(side = 1, "Observation error", line = 1.2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$obs_error==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(thresh_diff ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(quant_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[3], alpha.f = 0.3), border = threshcols[3], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
abline(h = 0, lty = 2)
# add mini plot showing functional form
#mtext(side = 4, "SK", las = 2, padj = 5)
text(x = boxpos[length(boxpos)] - 0.23, y = -1.9, "SK", cex = 1.2)
rect(xleft = boxpos[length(boxpos)], ybottom= -2.5, xright = boxpos[length(boxpos)] + 1.3, ytop = -1.2, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)], to = boxpos[length(boxpos)] + 0.7, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)/max(dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)) # mode is at (shape -1 )*scale
mini_y <- (-1.25 + 2.3)*big_y-2.3
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border


for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# bottom row: hockeystick
plot_dt <- focal_df[which(focal_df$shape=="hockeystick"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_method=="abs_max_d2") %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

#View(plot_dt)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(c("15", "25", "35"), each = 1)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[1], alpha.f = 0.3), border = threshcols[1], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = labpos, labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 1, "Time series length", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$ts_length==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(thresh_diff ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(obs_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[1], alpha.f = 0.3), border = threshcols[1], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = labpos, labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 1, "Observation error", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$obs_error==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(thresh_diff ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(quant_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols[1], alpha.f = 0.3), border = threshcols[1], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = labpos, labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 1, "Threshold quantile", line = 1.2, cex = xlab_cex)
#mtext(side = 4, "HS", las = 2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
# add mini plot showing functional form
#mtext(side = 4, "HS", las = 2, padj = 5)
text(x = boxpos[length(boxpos)] - 0.23, y = -1.9, "HS", cex = 1.2)
rect(xleft = boxpos[length(boxpos)], ybottom= -2.5, xright = boxpos[length(boxpos)] + 1.3, ytop = -1.2, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)], to = boxpos[length(boxpos)] + 0.7, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- ifelse(big_x < 0, 0, ifelse(big_x < mini_x[length(mini_x)/2], (0.9-0)/ (mini_x[length(mini_x)/2] - 0) * (big_x - mini_x[length(mini_x)/2]) + 0.9, 0.9))
mini_y <- (-1.25 + 2.3)*big_y-2.3
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border



for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols2[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols2[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# plot 10: dummy plot for legend
plot(0,type='n',axes=FALSE, ann = FALSE)
#legend(0.8, 0.2, col = threshcols, pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
#text(0.75, -0.4, "Threshold \ncalc. method", xpd = TRUE)
legend(0.8, 0.16, col = threshcols[1:3], pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
text(0.75, -0.6, "Threshold def.", xpd = TRUE)

dev.off()

```


## estimate precision

plot width of confidence intervals around threshold estimates

### CIs beeswarm

beeswarm plot in base R:
https://r-charts.com/distribution/beeswarm/

more details on the function:
https://www.rdocumentation.org/packages/beeswarm/versions/0.4.0/topics/beeswarm 


```{r}

# 3x3 figure w/ boxplots
boxpos <- c(1, 2, 3)#c(1:4, 7:10) # positions of the boxes

labpos <- c(1, 2, 3) # position of box labels on x axis

n_adj <-0.8 #0.5 # how far from top of box to adjust sample sizes
n_size <- 1 # font size of sample sizes

max_adj <- 0 # adjust ymax 


xlab_cex <- 0.8 # size to make x axis labels
col_cex <- 1.2 # font for column labels

# point type by condition: 1st element = CI int entirely in risk prone region, 2nd = CI in entirely in risk averse region, and 3rd = CI int includes true value
pt_types <- c(1, 15, 8)
# colors change depending on thresh_method used

pt_alphas <- c(0.8, 0.4, 0.8)

thresh_cols1 <- c(adjustcolor(threshcols[1], alpha.f = pt_alphas[1]), adjustcolor(threshcols[1], alpha.f = pt_alphas[2]), adjustcolor(threshcols[1], alpha.f = pt_alphas[3]))

thresh_cols2 <- c(adjustcolor(threshcols[2], alpha.f = pt_alphas[1]), adjustcolor(threshcols[2], alpha.f = pt_alphas[2]), adjustcolor(threshcols[2], alpha.f = pt_alphas[3]))

thresh_cols3 <- c(adjustcolor(threshcols[3], alpha.f = pt_alphas[1]), adjustcolor(threshcols[3], alpha.f = pt_alphas[2]), adjustcolor(threshcols[3], alpha.f = pt_alphas[3]))

corral_type <-  "wrap" # how to deal with observations that go out of the plot boundaries. "gutter" = pile them all on the ends, "wrap" = wrap them back around each other

plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% mutate(ci_int = ci_em_up-ci_em_low) %>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(inc_true = if_else(ci_em_up > thresh_true & ci_em_low < thresh_true, 1, 0)) %>% mutate(averse_frac = if_else(ci_em_low >= thresh_true, 1, if_else(ci_em_up <= thresh_true, 0, (ci_em_up-thresh_true)/(ci_em_up-ci_em_low))))

ymin <- min(plot_dt$ci_int, na.rm = T) 
ymax <- 3#max(plot_dt$ci_int, na.rm = T)+max_adj 
#ymax <- 1
#yaxt_at <- c(-2, -1, 0, 1, 2)# where to put y axis labels
yaxt_at <- round(seq(from = ymin, to = ymax, by = 1), 0)# where to put y axis labels
ylabs <- seq(from = ymin, to = ymax, by = 1)


pdf("figurepdfs/Best_CI_BSw_new.pdf", width = 7, height = 6) # width = 6.5
par(mfrow = c(4, 3))
layout(matrix(c(1, 4, 7, 10, 2, 5, 8, 10, 3, 6, 9, 10), nrow = 4, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1, 0.3))
#par(mar=c(0.1, 1.5, 0.5, 0), oma = c(1, 2, 1.2, 3))
par(mar=c(0.1, 0.5, 0.5, 0), oma = c(1, 3, 1.2, 0.5))
# top row: sigmoidal
plot_dt <- focal_df[which(focal_df$shape=="sigmoidal"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method=="min_d2") %>% mutate(ci_int = ci_em_up-ci_em_low) %>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(inc_true = if_else(ci_em_up > thresh_true & ci_em_low < thresh_true, 1, 0)) %>% mutate(averse_frac = if_else(ci_em_low >= thresh_true, 1, if_else(ci_em_up <= thresh_true, 0, (ci_em_up-thresh_true)/(ci_em_up-ci_em_low)))) %>% arrange(averse_frac)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(ci_int, na.rm = T)) %>% ungroup() 
plot_dt$ci_int <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$ci_int)


################ effect of ts length ####################

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(ts_length), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols2[1], ifelse(datasub$averse_frac==1, thresh_cols2[2], thresh_cols2[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "Time series length", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#pwpch = ifelse(datasub$averse_frac==0, 0,15)
legend("topleft", legend = c("fully in risk-averse side", "fully in risk-prone side", "includes true value"), pch = c(15, 1, 8), col = c(adjustcolor("gray40", alpha.f = 0.5), adjustcolor("gray40", alpha.f = 0.9),  adjustcolor("gray40", alpha.f = 0.9)), bty = "n")

# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(ci_int ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(obs_error), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols2[1], ifelse(datasub$averse_frac==1, thresh_cols2[2], thresh_cols2[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 3, "Observation error", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(ci_int ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(thresh_quant), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols2[1], ifelse(datasub$averse_frac==1, thresh_cols2[2], thresh_cols2[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SG", las = 2)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 3, "Threshold quantile", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
#mtext(side = 4, "HS", las = 2, padj = 5)
text(x = 2.79, y = 2.35, "SG", cex = 1.2)
rect(xleft = boxpos[length(boxpos)]-0.01, ybottom= 2, xright = boxpos[length(boxpos)] + 1, ytop = 2.75, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)]-0.01, to = boxpos[length(boxpos)] + 0.8, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-1, to = mini_x[length(mini_x)/2] + 1, length.out = 1000)
# y vals for real-size function: make these range from  0 to 1
big_y <- 1/(1 + exp(-6*(big_x-mini_x[length(mini_x)/2])))
mini_y <- (2.74-2)*big_y+2 # now squish the yvalues to fit in the mini plot (which has a yrange of ybottom to ytop in the rect function) and shift them to line up w/ the lower border of the plot
lines(x = mini_x, y = mini_y, type = "l") 

# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(ci_int ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# middle row: skew
#plot_dt <- focal_df[which(focal_df$shape=="skew"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_method =="zero_d1")

plot_dt <- focal_df[which(focal_df$shape=="skew"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method=="zero_d1") %>% mutate(ci_int = ci_em_up-ci_em_low) %>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(inc_true = if_else(ci_em_up > thresh_true & ci_em_low < thresh_true, 1, 0)) %>% mutate(averse_frac = if_else(ci_em_low >= thresh_true, 1, if_else(ci_em_up <= thresh_true, 0, (ci_em_up-thresh_true)/(ci_em_up-ci_em_low))))%>% arrange(averse_frac)

#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(ci_int, na.rm = T)) %>% ungroup() 
plot_dt$ci_int <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$ci_int)


################ effect of ts length ####################
datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(ts_length), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols3[1], ifelse(datasub$averse_frac==1, thresh_cols3[2], thresh_cols3[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 1, "Time series length", line = 1.2)
mtext(side = 2, "Precision (width of confidence interval around mean estimate)", line = 2) 
abline(h = 0, lty = 2)

# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(ci_int ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(obs_error), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols3[1], ifelse(datasub$averse_frac==1, thresh_cols3[2], thresh_cols3[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
#mtext(side = 1, "Observation error", line = 1.2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(ci_int ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(thresh_quant), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols3[1], ifelse(datasub$averse_frac==1, thresh_cols3[2], thresh_cols3[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SK", las = 2)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
#mtext(side = 1, "Threshold quantile", line = 1.2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
#mtext(side = 4, "HS", las = 2, padj = 5)
text(x = 2.79, y = 2.35, "SK", cex = 1.2)
rect(xleft = boxpos[length(boxpos)]-0.01, ybottom= 2, xright = boxpos[length(boxpos)] + 1, ytop = 2.75, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)]-0.01, to = boxpos[length(boxpos)] + 0.8, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)/max(dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)) # mode is at (shape -1 )*scale
mini_y <- (2.74-2)*big_y+2
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border


# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(ci_int ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# bottom row: hockeystick
#plot_dt <- focal_df[which(focal_df$shape=="hockeystick"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_method=="abs_max_d2")

plot_dt <- focal_df[which(focal_df$shape=="hockeystick"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_method=="abs_max_d2") %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% mutate(ci_int = ci_em_up-ci_em_low) %>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(inc_true = if_else(ci_em_up > thresh_true & ci_em_low < thresh_true, 1, 0)) %>% mutate(averse_frac = if_else(ci_em_low >= thresh_true, 1, if_else(ci_em_up <= thresh_true, 0, (ci_em_up-thresh_true)/(ci_em_up-ci_em_low))))%>% arrange(averse_frac)

plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(ci_int, na.rm = T)) %>% ungroup() 
plot_dt$ci_int <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$ci_int)

################ effect of ts length ####################
datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(ts_length), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols1[1], ifelse(datasub$averse_frac==1, thresh_cols1[2], thresh_cols1[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = labpos, labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 1, "Time series length", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(ci_int ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(obs_error), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols1[1], ifelse(datasub$averse_frac==1, thresh_cols1[2], thresh_cols1[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = labpos, labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 1, "Observation error", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(ci_int ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
beeswarm(ci_int ~ as.character(thresh_quant), data = datasub,
        at = boxpos, pwcol = ifelse(datasub$averse_frac==0, thresh_cols1[1], ifelse(datasub$averse_frac==1, thresh_cols1[2], thresh_cols1[3])), pwpch = ifelse(datasub$averse_frac==0, pt_types[1], ifelse(datasub$averse_frac==1, pt_types[2], pt_types[3])), xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", method = "center", corral = corral_type)
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = labpos, labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 1, "Threshold quantile", line = 1.2, cex = xlab_cex)
#mtext(side = 4, "HS", las = 2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
#mtext(side = 4, "HS", las = 2, padj = 5)
text(x = 2.79, y = 2.35, "HS", cex = 1.2)
rect(xleft = boxpos[length(boxpos)]-0.01, ybottom= 2, xright = boxpos[length(boxpos)] + 1, ytop = 2.75, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)]-0.01, to = boxpos[length(boxpos)] + 0.8, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- ifelse(big_x < 0, 0, ifelse(big_x < mini_x[length(mini_x)/2], (0.9-0)/ (mini_x[length(mini_x)/2] - 0) * (big_x - mini_x[length(mini_x)/2]) + 0.9, 0.9))
mini_y <- (2.74-2)*big_y+2
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border


# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(ci_int)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(ci_int ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# plot 10: dummy plot for legend
plot(0,type='n',axes=FALSE, ann = FALSE)
#legend(0.8, 0.2, col = threshcols, pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
#text(0.75, -0.4, "Threshold \ncalc. method", xpd = TRUE)
legend(0.8, 0.16, col = threshcols[1:3], pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
text(0.75, -0.6, "Threshold def.", xpd = TRUE)

dev.off()

```


### CIs segements

plot each individual line segment (from lower to upper CI), scaled so true thresh location = 0, and arranged by lower end (so the CI interval that goes furthest into the risk-prone side is on the left)


full figure

```{r}
boxpos <- c(1, 2, 3)#c(1:4, 7:10) # positions of the boxes

intwidth <- 0.4 # how far on each side of the box positions to let the CI segments go

ci_lwd <- 1.2 # thickness of the segments

labpos <- c(1, 2, 3) # position of box labels on x axis

n_adj <- 0.5 # how far from top of box to adjust sample sizes
n_size <- 1 # font size of sample sizes

max_adj <- 0.5 # adjust ymax 


xlab_cex <- 0.8 # size to make x axis labels
col_cex <- 1.2 # font for column labels

plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)%>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(ci_low_d = ci_em_low- thresh_true, ci_up_d = ci_em_up- thresh_true)%>% mutate(ci_int = (ci_up_d + ci_low_d)/2) #%>% mutate(ci_int = ci_up_d - ci_low_d)
ymin <- -2.5#min(plot_dt$ci_low_d, na.rm = T) 
ymax <- 3.5#max(plot_dt$ci_up_d, na.rm = T)+max_adj 
#yaxt_at <- c(-2, -1, 0, 1, 2)# where to put y axis labels
yaxt_at <- round(seq(from = ymin, to = ymax, by = 1), 0)# where to put y axis labels
ylabs <- seq(from = ymin, to = ymax, by = 1)


pdf("figurepdfs/Best_CI_seg.pdf", width = 6, height = 6)
par(mfrow = c(4, 3))
layout(matrix(c(1, 4, 7, 10, 2, 5, 8, 10, 3, 6, 9, 10), nrow = 4, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1, 0.3))
#par(mar=c(0.1, 1.5, 0.5, 0), oma = c(1, 2, 1.2, 3))
par(mar=c(0.1, 1.5, 0.5, 0), oma = c(1, 2, 1.2, 0.5))
# top row: sigmoidal
plot_dt <- focal_df[which(focal_df$shape=="sigmoidal"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method=="min_d2") %>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(ci_low_d = ci_em_low- thresh_true, ci_up_d = ci_em_up- thresh_true)%>% mutate(ci_int = (ci_up_d + ci_low_d)/2) #%>% mutate(ci_int = ci_up_d - ci_low_d)
#View(plot_dt)
# dummy points for cases where results for all sims were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(c("15", "25", "35"), each = 1)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d)  
#View(datasub)
boxplot(thresh_diff ~ as.character(ts_length), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "Time series length", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
text(x = 1.25, y = 2.8, "risk-averse side")
text(x = 1.25, y = -2, "risk-prone side")

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$ts_length==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$ts_length==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(thresh_diff ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


################ effect of obs error ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(obs_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(obs_error), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 3, "Observation error", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$obs_error==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$obs_error==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(thresh_diff ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(quant_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SG", las = 2)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 3, "Threshold quantile", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
#mtext(side = 4, "SG", las = 2, padj = 5)
text(x = 2.75, y = -1.9, "SG", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)], ybottom= -2.5, xright = boxpos[length(boxpos)] + 1.3, ytop = -1.2, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)], to = boxpos[length(boxpos)] + 0.7, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
# y vals for real-size function: make these range from  0 to 1
big_y <- 1/(1 + exp(-6*(big_x-mini_x[length(mini_x)/1.9])))
mini_y <- (-1.25 + 2.5)*big_y-2.5 # now squish the yvalues to fit in the mini plot (which has a yrange of ybottom to ytop in the rect function) and shift them to line up w/ the lower border of the plot
lines(x = mini_x, y = mini_y, type = "l")

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$thresh_quant==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# middle row: skew
plot_dt <- focal_df[which(focal_df$shape=="skew"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method =="zero_d1") %>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(ci_low_d = ci_em_low- thresh_true, ci_up_d = ci_em_up- thresh_true)%>% mutate(ci_int = (ci_up_d + ci_low_d)/2) #%>% mutate(ci_int = ci_up_d - ci_low_d)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

################ effect of ts length ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(c("15", "25", "35"), each = 1)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_low_d) %>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(ts_length), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 1, "Time series length", line = 1.2)
mtext(side = 2, "Confidence intervals around (mean estimate - true threshold)", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$ts_length==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$ts_length==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(thresh_diff ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(obs_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_low_d) %>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(obs_error), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$obs_error==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$obs_error==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(thresh_diff ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(quant_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
abline(h = 0, lty = 2)

# add mini plot showing functional form
#mtext(side = 4, "SK", las = 2, padj = 5)
text(x = 2.75, y = -1.9, "SK", cex = 1.2)
rect(xleft = boxpos[length(boxpos)], ybottom= -2.5, xright = boxpos[length(boxpos)] + 1.3, ytop = -1.2, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)], to = boxpos[length(boxpos)] + 0.7, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)/max(dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)) # mode is at (shape -1 )*scale
mini_y <- (-1.25 + 2.5)*big_y-2.5
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border


for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$thresh_quant==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# bottom row: hockeystick
plot_dt <- focal_df[which(focal_df$shape=="hockeystick"),] %>% filter(best_mod=="gam") %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method=="abs_max_d2")%>% mutate(thresh_true = thresh_mean-thresh_diff) %>% mutate(ci_low_d = ci_em_low- thresh_true, ci_up_d = ci_em_up- thresh_true)%>% mutate(ci_int = (ci_up_d + ci_low_d)/2) #%>% mutate(ci_int = ci_up_d - ci_low_d)

plot_dt <- plot_dt %>% group_by(obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)


################ effect of ts length ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(c("15", "25", "35"), each = 1)

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(ts_length), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = labpos, labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 1, "Time series length", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$ts_length==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$ts_length==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length) 
boxbnds <- boxplot(thresh_diff ~ as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of obs error ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(obs_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(obs_error), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = labpos, labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 1, "Observation error", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$obs_error==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$obs_error==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error) 
boxbnds <- boxplot(thresh_diff ~ as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ effect of threshold quantile ####################
levels <- matrix(NA, nrow = 3, ncol = 2) # levels for jittering points
levels[, 1] <- rep(NA, 3)
levels[,2] <- rep(as.character(quant_set), each = 1)

datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1])%>% arrange(ci_int)#%>% arrange(ci_low_d) 
#View(datasub)
boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,
        at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = labpos, labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 1, "Threshold quantile", line = 1.2, cex = xlab_cex)
#mtext(side = 4, "HS", las = 2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
#mtext(side = 4, "HS", las = 2, padj = 5)
text(x = 2.75, y = -1.9, "HS", cex = 1.2)
rect(xleft = boxpos[length(boxpos)], ybottom= -2.5, xright = boxpos[length(boxpos)] + 1.3, ytop = -1.2, border = "black")
mini_x <- seq(from = boxpos[length(boxpos)], to = boxpos[length(boxpos)] + 0.7, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- ifelse(big_x < 0, 0, ifelse(big_x < mini_x[length(mini_x)/2], (0.9-0)/ (mini_x[length(mini_x)/2] - 0) * (big_x - mini_x[length(mini_x)/2]) + 0.9, 0.9))
mini_y <- (-1.25 + 2.5)*big_y-2.5
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border

for(i in 1:nrow(levels)){
  y1vals <- datasub$ci_low_d[which(datasub$thresh_quant==as.numeric(levels[i, 2]))] 
  y1vals <- y1vals[which(is.na(y1vals)==F)]
  y2vals <- datasub$ci_up_d[which(datasub$thresh_quant==as.numeric(levels[i, 2]))]
  y2vals <- y2vals[which(is.na(y2vals)==F)]
  x12s <- seq(from = boxpos[i]- intwidth, to = boxpos[i] + intwidth, length.out = length(y1vals))
  segments(x0 = x12s, y0=y1vals, y1 = y2vals, col=ifelse(datasub$thresh_method[1]=="abs_max_d2", threshcols[1], ifelse(datasub$thresh_method[1]=="min_d2", threshcols[2], ifelse(datasub$thresh_method[1]=="zero_d1", threshcols[3], threshcols[4]))), lwd = ci_lwd) 
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant) 
boxbnds <- boxplot(thresh_diff ~ as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# plot 10: dummy plot for legend
plot(0,type='n',axes=FALSE, ann = FALSE)
legend(0.8, 0.16, col = threshcols[1:3], pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
text(0.75, -0.6, "Threshold def.", xpd = TRUE)

dev.off()

```


# all functions

plots for focal and non-focal driver-response relationships

plot the shapes of these functions and their derivatives:

```{r}

# get best case scenario pars
tmaxb <- 500
thresh_quantb <- 0.5
# obs error doesn't matter bc using response not obs_response

driver_pars_b = list(x_min = NULL, x_max = NULL, thresh_quant = thresh_quantb, x_df = 10, x_sd = 1, uniform = F) # increase x_sd to have more values at the ends


# control pars for each driver-response relationship (need to be the same as in simulations_v3)
# sigmoid v1
control_pars_sg1 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 1, hs_a = NULL, skew_cv = 1, skew_conc = "up", sig_k = 1.5, lin_m = 1, lin_b = 0)

# skew v1 (concave down)
control_pars_sk1 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 2, hs_a = NULL, skew_cv = 1, skew_conc = "down", sig_k = 1.5, lin_m = 1, lin_b = 0)

# hockey stick v1
control_pars_hs1 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 1, hs_a = NULL, skew_cv = 1, skew_conc = "up", sig_k = 1.5, lin_m = 1, lin_b = 0)

# linear
control_pars_ln1 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 1, hs_a = NULL, skew_cv = 1, skew_conc = "up", sig_k = 1.5, lin_m = 0.5, lin_b = 0) # changed m from 1 to 0.5


# nonfocal functions
# control pars for each driver-response relationship
# sigmoid v2
control_pars_sg2 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 2, hs_a = NULL, skew_cv = 1, skew_conc = "up", sig_k = -1.5, lin_m = 1, lin_b = 0)

# skew v2 (concave up)
control_pars_sk2 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 1, hs_a = NULL, skew_cv = 1, skew_conc = "up", sig_k = 1.5, lin_m = 1, lin_b = 0)

# hockey stick v2
control_pars_hs2 <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 2, hs_a = NULL, skew_cv = 1, skew_conc = "up", sig_k = 1.5, lin_m = 1, lin_b = 0)

# step
control_pars_st <- list(thresh_loc = 3, thresh_loc_sd = 0, y_max = 3, y_min = 0, hs_type = 1, hs_a = 3, skew_cv = 1, skew_conc = "up", sig_k = 1.5, lin_m = 1, lin_b = 0)


```

### focal functions

```{r}

thresh_lwd <- 2 # thickness of lines denoting threshold locations

thresh_lty <- c(1, 2, 1, 1) # line types

thresh_pch <- c(1, 16, 16, 16) # point types
thresh_pt_cex <- c(1.5, 1.3, 1.3, 1.3) # point sizes

ymin <- 0
ymax <- 3

fit_lwd <- 1.5

pdf("figurepdfs/S_FocalFits.pdf", width = 6, height = 5.5)
# top row = jackknifed gams w/ true function overlaid, middle = jackknifed
par(mfrow = c(3, 3))
layout(matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1))
par(mar=c(2, 2.5, 0.1, 0), oma = c(2, 2, 1, 0.5))
#layout.show(9)
######################### skew v1 ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "skew", control_pars = control_pars_sk1, driver_pars = driver_pars_b) 
fun_test1$driver <- zfun(fun_test1$driver)
#fun_test1$obs_response <- zfun(fun_test1$obs_response)
#fun_test1$response <- zfun(fun_test1$response)
# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))


# threshold calculations
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)

fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))#, ylim = c(ymin, ymax)
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
#abline(v = control_pars_sk1$thresh_loc, lty = 2)
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 3, "skew") #, adj = 0
#mtext(side = 1, "driver", line = 2.5)
mtext(side = 2, "response", line = 2.5)#, outer = TRUE
text(x = 1.5, y =0.4, "true \nrelationship", col = "black")
text(x = 4, y =1.5, "true \nthreshold", col = "black")
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch[pp], cex=thresh_pt_cex[pp])
}


plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 2, "s'(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty =2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])

######################### sigmoid v1 ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "sigmoidal", control_pars = control_pars_sg1, driver_pars = driver_pars_b)
fun_test1$driver <- zfun(fun_test1$driver)
#fun_test1$obs_response <- zfun(fun_test1$obs_response)
#fun_test1$response <- zfun(fun_test1$response)

# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))

# threshold calculations
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)


fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 3, "sigmoidal") #, adj = 0
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "response", line = 2.5)#, outer = TRUE
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead of lines
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch[pp], cex=thresh_pt_cex[pp])
}

plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
#mtext(side = 2, "s'(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])


######################### hockeystick v1 ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "hockeystick", control_pars = control_pars_hs1, driver_pars = driver_pars_b)
fun_test1$driver <- zfun(fun_test1$driver)
#fun_test1$obs_response <- zfun(fun_test1$obs_response)
#fun_test1$response <- zfun(fun_test1$response)
# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))

# threshold calculations
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)


fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
#text(x = 2.5, y = 1, "true \nthreshold")
mtext(side = 3, "hockeystick") #, adj = 0
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "response", line = 2.5)#, outer = TRUE
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead of lines
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch[pp], cex=thresh_pt_cex[pp])
}


plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s'(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])

dev.off()


```



### nonfocal functions

```{r}
# will have 4 columns (4 functions)... or maybe 3 since difference from true doesn't make sense for linear
thresh_lwd <- 2

thresh_lty <- c(1, 1, 1, 1)

thresh_pch <- c(16, 16, 16, 16)
thresh_pt_cex <- c(1.3, 1.3, 1.3, 1.3)

thresh_pch2 <- c(1, 16, 16, 16)
thresh_pt_cex2 <- c(1.5, 1.3, 1.3, 1.3)


ymin <- -0.5
ymax <- 3.5

pdf("figurepdfs/S_NonfocalFits.pdf", width = 7, height = 6)
# top row = jackknifed gams w/ true function overlaid, middle = jackknifed
par(mfrow = c(3, 4))
layout(matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), nrow = 3, ncol = 4), widths = c(1, 1, 1, 1), heights = c(1, 1, 1))
par(mar=c(2, 2.5, 0.1, 0), oma = c(2, 2, 1, 0.5))
#layout.show(9)
######################### skew v2 ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "skew", control_pars = control_pars_sk2, driver_pars = driver_pars_b) 
fun_test1$driver <- zfun(fun_test1$driver)
# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))


# threshold calculations
# d1 = 0
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)


fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 3, "skew 2") #, adj = 0
text(x = 1.5, y =3, "true \nrelationship", col = "black")
text(x = 4.25, y =1.6, "true \nthreshold", col = "black")
#mtext(side = 1, "driver", line = 2.5)
mtext(side = 2, "response", line = 2.5)#, outer = TRUE
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch[pp], cex=thresh_pt_cex[pp])
}

plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 2, "s'(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = control_pars_sk1$thresh_loc, lty =2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])

######################### sigmoid v2 ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "sigmoidal", control_pars = control_pars_sg2, driver_pars = driver_pars_b)
fun_test1$driver <- zfun(fun_test1$driver)
# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))

# threshold calculations
# d1 = 0
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)
thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)


fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))
abline(v = control_pars_sg2$thresh_loc, lty = 2)
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 3, "sigmoidal 2") #, adj = 0
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "response", line = 2.5)#, outer = TRUE
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch2[pp], cex=thresh_pt_cex2[pp])
}

plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
#mtext(side = 2, "s'(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])


######################### hockeystick v2 ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "hockeystick", control_pars = control_pars_hs2, driver_pars = driver_pars_b)
fun_test1$driver <- zfun(fun_test1$driver)
# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))

# threshold calculations
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)


fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 3, "hockeystick 2") #, adj = 0
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "response", line = 2.5)#, outer = TRUE
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch[pp], cex=thresh_pt_cex[pp])
}

plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s'(x)", line = 2.5)#, outer = TRUE
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])



######################### step ###########################################
fun_test1 <- sim_data(nsim = 1, tmax = tmaxb, fun = "hockeystick", control_pars = control_pars_st, driver_pars = driver_pars_b)
fun_test1$driver <- zfun(fun_test1$driver)
# gam fits and derivs
gam_ex <- gam(response~s(driver,k=4,bs="tp"),data = fun_test1) 
pred_ex <- gratia::fitted_values(gam_ex, data = xdt)
pred_ex_up <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$upper, driver = xvals1), span=0.1))
pred_ex_mn <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$fitted, driver = xvals1), span=0.1))
pred_ex_low <- predict(loess(pred ~ driver, data=data.frame(pred = pred_ex$lower, driver = xvals1), span=0.1))
# first deriv
D1_ex <- gratia::derivatives(gam_ex, data = xdt, order = 1, eps = 5*10^-6)
D1_ex_up <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$upper, driver = xvals1), span=0.1))
D1_ex_mn <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$derivative, driver = xvals1), span=0.1))
D1_ex_low <- predict(loess(d1 ~ driver, data=data.frame(d1 = D1_ex$lower, driver = xvals1), span=0.1))
D2_ex <- gratia::derivatives(gam_ex, data = xdt, order = 2, eps = 5*10^-6)
D2_ex_up <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$upper, driver = xvals1), span=0.1))
D2_ex_mn <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$derivative, driver = xvals1), span=0.1))
D2_ex_low <- predict(loess(d2 ~ driver, data=data.frame(d2 = D2_ex$lower, driver = xvals1), span=0.1))

# threshold calculations
# d1 = 0
# d1 = 0
# root_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low){
d1_zero_ex <- root_threshF(D1_ex_mn, sig_type = sig_choice, xvals1, D1_ex_up, D1_ex_low)

# d2 = 0
d2_zero_ex <- root_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low)

# min d2
#min_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2min_ex <- min_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

# abs max d2
# abs_max_threshF <- function(deriv_i, sig_type, xvals, deriv_up, deriv_low, pkht, pkup){
d2max_ex <- abs_max_threshF(D2_ex_mn, sig_type = sig_choice, xvals1, D2_ex_up, D2_ex_low, pkht = 10^-3, pkup = 3)

thresh_ex <- c(d2max_ex, d2min_ex, d1_zero_ex, d2_zero_ex)


fun_test1 <- fun_test1[order(fun_test1$driver),] # for plotting as a line rather than points
plot(x = fun_test1$driver, fun_test1$response, las = 1, xlab = NA, ylab = NA, type = "l", col = "gray30", lwd = 3, lty = 3, xlim = c(min(xvals1), max(xvals1)), ylim = c(ymin, ymax))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
lines(x = fun_test1$driver, fun_test1$response, col = "gray30", type = "l")
lines(x = xvals1, y = pred_ex_mn, type = "l", lwd = fit_lwd)
polygon(x = c(xvals1, rev(xvals1)), y = c(pred_ex_low, rev(pred_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 3, "step") #, adj = 0
#mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "response", line = 2.5)#, outer = TRUE
#text(x = 0.25, y = 2.5, "'bad' side")
#text(x = 4.5, y = 1, "'good' side")
#abline(v = thresh_ex[which(is.na(thresh_ex)==F)], col = threshcols[which(is.na(thresh_ex)==F)], lwd = thresh_lwd, lty = thresh_lty)
# add thresholds as points instead
for(pp in 1:length(thresh_ex[which(is.na(thresh_ex)==F)])){
points(x = thresh_ex[which(is.na(thresh_ex)==F)][pp], y = pred_ex_mn[which(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])==min(abs(xvals1-thresh_ex[which(is.na(thresh_ex)==F)][pp])))][1], col = threshcols[which(is.na(thresh_ex)==F)][pp], pch = thresh_pch[pp], cex=thresh_pt_cex[pp])
}

plot(x = xvals1, D1_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D1_ex_low, rev(D1_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
#abline(h = 0, lty = 2)
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[3], col = threshcols[3], lwd = thresh_lwd)

plot(x = xvals1, D2_ex_mn, las = 1, xlab = NA, ylab = NA, type = "l", xlim = c(min(xvals1), max(xvals1)))
abline(v = fun_test1$thresh_loc_z[1], lty = 2)
polygon(x = c(xvals1, rev(xvals1)), y = c(D2_ex_low, rev(D2_ex_up)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
mtext(side = 1, "driver", line = 2.5)
#mtext(side = 2, "s''(x)", line = 2.5)#, outer = TRUE
abline(h = 0, lty = 1, col = "gray", lwd = 0.8)
abline(v = thresh_ex[c(1, 2, 4)], col = threshcols[c(1, 2, 4)], lwd = thresh_lwd, lty = thresh_lty[c(1, 2, 4)])

dev.off()

```


## all fun boxplots

boxplots showing estimate bias for focal + nonfocal driver-response relationships, with default parameter values


```{r}


boxpos <- c(1:4)#c(1:4, 7:10) # positions of the boxes

levels <- matrix(NA, nrow = 4, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 1)
levels[,2] <- rep(NA, 4)

#levels

n_adj <- 0.5 # how far from top of box to adjust sample sizes
n_size <- 1 # font size of sample sizes

yaxt_at <- c(-2, -1, 0, 1, 2, 3)# where to put y axis labels

plot_dt <- rbind(focal_df, nonfocal_df) %>% filter(best_mod == "gam")%>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) 

ymin <- min(plot_dt$thresh_diff, na.rm = T) 
ymax <- max(plot_dt$thresh_diff, na.rm = T) + 0.5 
ylabs <- seq(from = ymin, to = ymax, by = 1)

# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(thresh_method, shape) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

#View(nonfocal_df)

pdf("figurepdfs/S_AllBxPlt.pdf", width = 6)
par(mfrow = c(4, 2))
layout(matrix(c(1, 2, 3, 4, 5, 6, 7, 8), nrow = 4, ncol = 2), widths = c(1, 1), heights = c(1, 1, 1, 1))
#layout.show(8)
par(mar=c(2, 0.6, 0.1, 0), oma = c(2, 3, 2, 0.5))

# focal data
plot_dt <- focal_df %>% filter(best_mod == "gam")%>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) 

# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(thresh_method, shape) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

# FIRST PANEL: FOCAL SIGMOIDAL
datasub <- plot_dt %>% filter(shape == "sigmoidal") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las=1)
mtext(side = 3, "sigmoidal", line = 0)#adj = 0, 
#mtext(side = 2, "Difference from true threshold", line = 2.5) 
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-averse side")
text(x = 1, y = -1.5, "risk-prone side")
#axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# SECOND PANEL: FOCAL SKEW
datasub <- plot_dt %>% filter(shape == "skew") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
mtext(side = 3, "skew", line = 0)#adj = 0, 
#mtext(side = 2, "Difference from true threshold", line = 2.5) 
mtext(side = 2, "Bias (mean estimate - true threshold)", line = 2) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-averse side")
text(x = 1, y = -1.5, "risk-prone side")
#axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# THIRD PANEL: FOCAL HOCKEYSTICK

datasub <- plot_dt %>% filter(shape == "hockeystick") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
mtext(side = 3, "hockeystick", line = 0)#adj = 0, 
#mtext(side = 2, "Difference from true threshold", line = 2) 
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-averse side")
text(x = 1, y = -1.5, "risk-prone side")
axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# FOURTH PANEL: LEGEND

plot(0,type='n',axes=FALSE, ann = FALSE)
legend("center", fill = threshcols, border = threshcols, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), title = "Threshold definition", bty = "n", ncol = 2, cex = 1.3)
#x = 0.8, y = 0.2
#legend(0.8, 0.2, col = threshcols, pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
#text(0.75, -0.4, "Threshold \ncalc. method", xpd = TRUE)


# FIFTH PANEL: NONFOCAL SIGMOIDAL

# nonfocal data
plot_dt <- nonfocal_df %>% filter(best_mod == "gam")%>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)%>% filter(thresh_n_full %in% c(1, NA))  %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) 

plot_dt <- plot_dt %>% group_by(thresh_method, shape) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

datasub <- plot_dt %>% filter(shape == "sigmoidal") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1, labels = NA)
mtext(side = 3, "sigmoidal 2", line = 0)#adj = 0, 
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-prone side")
text(x = 1, y = -2, "risk-averse side")
#axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# SIXTH PANEL: NONFOCAL SKEW
datasub <- plot_dt %>% filter(shape == "skew") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1, labels = NA)
mtext(side = 3, "skew 2", line = 0)#adj = 0, 
#mtext(side = 2, "Mean estimate - true threshold", line = 2, adj = 2.5) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-averse side")
text(x = 1, y = -1.5, "risk-prone side")
#axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# SEVENTH PANEL: NONFOCAL HOCKEYSTICK
datasub <- plot_dt %>% filter(shape == "hockeystick") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
mtext(side = 3, "hockeystick 2", line = 0)#adj = 0, 
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-averse side")
text(x = 1, y = -1.5, "risk-prone side")
#axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# EIGHTH PANEL: NONFOCAL STEP
datasub <- plot_dt %>% filter(shape == "step") # data to plot
boxplot(thresh_diff ~ thresh_method, data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
mtext(side = 3, "step", line = 0)#adj = 0, 
#mtext(side = 2, "Difference from true threshold", line = 2) 
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#mtext(side = 1, "Threshold calculation method", line = 2)
text(x = 1, y = 2.75, "risk-averse side")
text(x = 1, y = -1.5, "risk-prone side")
axis(side = 1, at = boxpos, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = F, line = -0.5)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$thresh_method==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  set.seed(555)
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method, data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

dev.off()

```


# sig criteria bxps

focal boxplots showing estimate bias for the 3 different significance criteria (none, jackknifed quantiles, and simultaneous intervals), with default simulation parameters

show all threshold definitions for each driver-response relationship

```{r}
# 3x3 figure w/ boxplots
boxpos <- c(1:4)#c(1:4, 7:10) # positions of the boxes

levels <- matrix(NA, nrow = 4, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("abs_max_d2", "min_d2", "zero_d1", "zero_d2"), 1)
levels[,2] <- rep(NA, 4)

#levels

n_adj <- 0.5 # how far from top of box to adjust sample sizes

n_size <- 1 # font size of sample sizes

max_adj <- 0.5 # adjust ymax 

xlab_cex <- 0.8 # size to make x axis labels
col_cex <- 1.2 # font for column labels

x_cex <- 0.5 # tick label size

plot_dt <- focal_df %>% filter(best_mod=="gam")%>% filter(thresh_fraction >= sig_thresh) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_fraction >= sig_thresh)

#View(plot_dt)

ymin <- min(plot_dt$thresh_diff, na.rm = T)-0.6 
ymax <- max(plot_dt$thresh_diff, na.rm = T)+max_adj 
#yaxt_at <- c(-2, -1, 0, 1, 2)# where to put y axis labels
yaxt_at <- round(seq(from = ymin, to = ymax, by = 1), 0)# where to put y axis labels
ylabs <- seq(from = ymin, to = ymax, by = 1)


pdf("figurepdfs/S_SigBoxPlots.pdf", width = 7, height = 6)
par(mfrow = c(4, 3))
layout(matrix(c(1, 4, 7, 2, 5, 8, 3, 6, 9), nrow = 3, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1))
#par(mar=c(0, 1.5, 0.5, 0), oma = c(0, 2, 3, 3))
par(mar=c(0, 0.5, 0.5, 0), oma = c(3, 3, 1, 0.5))
# top row: sigmoidal
plot_dt <- focal_df[which(focal_df$shape=="sigmoidal"),] %>% filter(best_mod=="gam")  %>% filter(thresh_fraction >= sig_thresh) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_fraction >= sig_thresh)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(thresh_method, obs_error, ts_length, cov_sd, thresh_quant, sig_type) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

#View(plot_dt)

################ criteria = none ####################
datasub <- plot_dt %>% filter(sig_type=="none") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "No significance criteria", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
text(x = 1.2, y = 2.8, "risk-averse side")
text(x = 1.2, y = -2, "risk-prone side")

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ jack quant ####################
datasub <- plot_dt %>% filter(sig_type=="jack_quant") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
mtext(side = 3, "Jackknifed quantiles", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ sim int ####################
datasub <- plot_dt %>% filter(sig_type=="sim_int") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SG", las = 2)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
mtext(side = 3, "Simultaneous intervals", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# add mini plot showing functional form
#mtext(side = 4, "SG", las = 2, padj = 5)
text(x = boxpos[4]-0.45, y = -2, "SG", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)]-0.25, ybottom= -2.8, xright = boxpos[length(boxpos)]+0.5, ytop = -1.5, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)]-0.25, to = boxpos[length(boxpos)]+0.5, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
# y vals for real-size function: make these range from  0 to 1
big_y <- 1/(1 + exp(-6*(big_x-mini_x[length(mini_x)/1.9])))
mini_y <- (-1.5 + 2.8)*big_y-2.8 # now squish the yvalues to fit in the mini plot (which has a yrange of ybottom to ytop in the rect function) and shift them to line up w/ the lower border of the plot
lines(x = mini_x, y = mini_y, type = "l") 


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# middle row: skew
plot_dt <- focal_df[which(focal_df$shape=="skew"),] %>% filter(best_mod=="gam") %>% filter(thresh_fraction >= sig_thresh) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_fraction >= sig_thresh)
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(thresh_method, obs_error, ts_length, cov_sd, thresh_quant, sig_type) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

#View(plot_dt)


################ no sig criteria ####################
datasub <- plot_dt %>% filter(sig_type=="none") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 1, "Time series length", line = 1.2)
mtext(side = 2, "Bias (mean estimate - true threshold)", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ jack quant ####################
datasub <- plot_dt %>% filter(sig_type=="jack_quant") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
#mtext(side = 1, "Observation error", line = 1.2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ sim int ####################
datasub <- plot_dt %>% filter(sig_type=="sim_int") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

# add mini plot showing functional form
#mtext(side = 4, "SK", las = 2, padj = 5)
text(x = boxpos[4]-0.45, y = -2, "SK", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)]-0.25, ybottom= -2.8, xright = boxpos[length(boxpos)]+0.5, ytop = -1.5, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)]-0.25, to = boxpos[length(boxpos)]+0.5, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-3, to = mini_x[length(mini_x)/2] + 3, length.out = 1000)
big_y <- dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)/max(dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)) # mode is at (shape -1 )*scale
mini_y <- (-1.55 + 2.8)*big_y-2.9
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border



# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# bottom row: hockeystick
plot_dt <- focal_df[which(focal_df$shape=="hockeystick"),] %>% filter(best_mod=="gam") %>% filter(thresh_fraction >= sig_thresh) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(thresh_fraction >= sig_thresh)

plot_dt <- plot_dt %>% group_by(thresh_method, obs_error, ts_length, cov_sd, thresh_quant, sig_type) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)

#View(plot_dt)

################ no sig criteria ####################
datasub <- plot_dt %>% filter(sig_type=="none") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
axis(side = 1, at = boxpos, labels = c("max(|s''|)", "min(s'')", "s'=0", "s''=0"), tick = F, line = -0.5, cex = x_cex)
#mtext(side = 1, "Time series length", line = 1.2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, ts_length) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(ts_length, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(ts_length), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ jack quant ####################
datasub <- plot_dt %>% filter(sig_type=="jack_quant") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("cv ~ 0.01", "cv ~ 0.2", "cv ~ 1"), tick = F, line = -1)
axis(side = 1, at = boxpos, labels = c("max(|s''|)", "min(s'')", "s'=0", "s''=0"), tick = F, line = -0.5, cex = x_cex)
mtext(side = 1, "Threshold definition", line = 2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, obs_error) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(obs_error, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(obs_error), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)

################ sim int ####################
datasub <- plot_dt %>% filter(sig_type=="sim_int") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,
        at = boxpos, col = adjustcolor(threshcols, alpha.f = 0.3), border = threshcols, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("0.05", "0.25", "0.5"), tick = F, line = -1)
axis(side = 1, at = boxpos, labels = c("max(|s''|)", "min(s'')", "s'=0", "s''=0"), tick = F, line = -0.5, cex = x_cex)
#mtext(side = 1, "Threshold calc. method", line = 1.2, cex = xlab_cex)
#mtext(side = 4, "HS", las = 2)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

# add mini plot showing functional form
text(x = boxpos[4]-0.45, y = -2, "HS", cex = 1.2)
# plot border
rect(xleft = boxpos[length(boxpos)]-0.25, ybottom= -2.8, xright = boxpos[length(boxpos)]+0.5, ytop = -1.5, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)]-0.25, to = boxpos[length(boxpos)]+0.5, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/2]-5, to = mini_x[length(mini_x)/2] + 5, length.out = 1000)
big_y <- ifelse(big_x < 0, 0, ifelse(big_x < mini_x[length(mini_x)/2], (0.9-0)/ (mini_x[length(mini_x)/2] - 0) * (big_x - mini_x[length(mini_x)/2]) + 0.9, 0.9))
mini_y <- (-1.5 + 2.8)*big_y-2.8
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border

for(i in 1:nrow(levels)){
  yvals <- datasub$thresh_diff[which(datasub$thresh_method==levels[i,1])] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=20, col=ifelse(levels[i, 1]=="abs_max_d2", threshcols2[1], ifelse(levels[i, 1]=="min_d2", threshcols2[2], ifelse(levels[i, 1]=="zero_d1", threshcols2[3], threshcols2[4])))) 
   
}
# adding sample sizes
n_group <- datasub %>% group_by(thresh_method, thresh_quant) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(thresh_quant, thresh_method) 
boxbnds <- boxplot(thresh_diff ~ thresh_method + as.character(thresh_quant), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = boxbnds[nrow(boxbnds), ] + n_adj, as.character(n_group$n), cex = n_size)


# plot 10: dummy plot for legend
#plot(0,type='n',axes=FALSE, ann = FALSE)
#legend(0.8, 0.2, col = threshcols, pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
#text(0.75, -0.4, "Threshold \ncalc. method", xpd = TRUE)

dev.off()

```


# covariate effects 

plots showing effects of having a covariate that also influences the response

## boxplots

boxplots for best threshold definition only, grouped by with vs. without cov included in estimation model (open vs. closed points and unfilled vs. filled boxes)

```{r}

# checking layout
#layout(matrix(c(1, 4, 7, 10, 2, 5, 8, 10, 3, 6, 9, 10), nrow = 4, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1, 0.3))
#layout.show(10)

#layout(matrix(c(1, 3, 5, 7, 2, 4, 6, 7), nrow = 4, ncol = 2), widths = c(1, 1), heights = c(1, 1, 1, 0.3))
#layout.show(7)

```


```{r}

unique(linexp_cov$best_mod) # checking which estimation models were "best" (lowest AIC) across all the simulations

```


significantly nonlinear driver-response relationship means best mod is either gam (=nonlinear driver and cov not in model), gam_DC (=nonlinear driver and covariate), or gam_DCl (= nonlinear driver and linear covariate) and delta AIC is greater than 2 (or delta AIC is not greater than 2, but the next best model also has a nonlinear driver -- so all the cases where there isn't an "ns" at the end, because an "ns" means the difference between the nonlinear model with the smallest AIC and the linear model with the smallest AIC was not greater than 2)

```{r}
# 3x2 figure w/ boxplots

threshcols22 <- adjustcolor(threshcols, alpha.f = 0.4)

boxpos <- c(1:2, 5:6, 9:10)# positions of the boxes

n_adj <- 0.5 # how far from top of box to adjust sample sizes
n_adj2 <- 0.1
n_size <- 1 # font size of sample sizes

max_adj <- 0.2#0.1 # adjust ymax 
min_adj <- 0.5 # adjust ymin

xlab_cex <- 0.8 # size to make x axis labels
col_cex <- 1.2 # font for column labels

alpha2 <- 0.4

plot_dt1 <- linexp_cov %>% filter(best_mod %in% c("gam", "gam_DC", "gam_DCl")) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method =="min_d2" & shape=="sigmoidal")

plot_dt2 <- linexp_cov %>% filter(best_mod %in% c("gam", "gam_DC", "gam_DCl")) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method =="zero_d1" & shape=="skew")

plot_dt3 <- linexp_cov %>% filter(best_mod %in% c("gam", "gam_DC", "gam_DCl")) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method =="abs_max_d2" & shape=="hockeystick")

plot_dt <- rbind(plot_dt1, plot_dt2, plot_dt3)

#View(plot_dt)

ymin <- min(plot_dt$thresh_diff, na.rm = T)-min_adj 
ymax <- max(plot_dt$thresh_diff, na.rm = T)+max_adj 
#yaxt_at <- c(-2, -1, 0, 1, 2)# where to put y axis labels
yaxt_at <- round(seq(from = ymin, to = ymax, by = 1), 0)# where to put y axis labels
ylabs <- seq(from = ymin, to = ymax, by = 1)


pdf("figurepdfs/Cov_bxpt_linexp_test.pdf", width = 5, height = 6)
par(mfrow = c(4, 2))
layout(matrix(c(1, 3, 5, 7, 2, 4, 6, 7), nrow = 4, ncol = 2), widths = c(1, 1), heights = c(1, 1, 1, 0.3))
#layout.show(10)
#par(mar=c(0, 1.5, 0.5, 0), oma = c(0, 2, 3, 3))
par(mar=c(0, 1.5, 0.5, 0), oma = c(0, 2, 1.5, 0.5))
# top row: sigmoidal
plot_dt <- linexp_cov[which(linexp_cov$shape=="sigmoidal"),] %>% filter(best_mod %in% c("gam", "gam_DC", "gam_DCl")) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)%>% filter(thresh_method=="min_d2")
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(cov_inc, obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)
plot_dt$thresh_diff <- ifelse(plot_dt$cov_sd==0 & plot_dt$cov_inc=="Y", -9999, plot_dt$thresh_diff)

################ linear cov ####################
levels <- matrix(NA, nrow = 6, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("N", "Y"), 3)
levels[,2] <- rep(c("0", "0.5", "1"), each = 2)

datasub <- plot_dt %>% filter(cov_type=="linear") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,
        at = boxpos, col = c(adjustcolor(threshcols[2], alpha.f = 0), adjustcolor(threshcols[2], alpha.f = 0.3)), border = threshcols[2], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "Linear covariate", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
text(x = 3, y = 2, "risk-averse \nside")
text(x = 3, y = -1, "risk-prone \nside")
#legend(x = "bottomright", legend = c("s(x)", "s(x) + s(x1)"), col = "gray30", pch = c(1, 16), title = "Model")#, bty = "n"
legend(x = "bottomright", legend = c("x", expression(x~+~x[2])), col = "gray30", pch = c(1, 16), title = "Variables in model", ncol = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$cov_inc==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$cov_inc==levels[i,1] & datasub$cov_sd==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=ifelse(levels[i, 1]=="N", 1, 16), col=ifelse(levels[i, 1]=="N", adjustcolor(threshcols[2], alpha.f = alpha2), threshcols22[2])) 
}
# adding sample sizes
n_group <- datasub %>% group_by(cov_inc, cov_sd) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(cov_sd, cov_inc) 
boxbnds <- boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = ifelse(boxbnds[nrow(boxbnds), ] + n_adj < ymax, boxbnds[nrow(boxbnds), ] + n_adj, boxbnds[nrow(boxbnds), ] + n_adj2), as.character(n_group$n), cex = n_size)


################ exponential cov ####################
levels <- matrix(NA, nrow = 6, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("N", "Y"), 3)
levels[,2] <- rep(c("0", "0.5", "1"), each = 2)

datasub <- plot_dt %>% filter(cov_type=="exp") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,
        at = boxpos, col = c(adjustcolor(threshcols[2], alpha.f = 0), adjustcolor(threshcols[2], alpha.f = 0.3)), border = threshcols[2], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
mtext(side = 3, "Exponential covariate", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$cov_inc==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$cov_inc==levels[i,1] & datasub$cov_sd==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=ifelse(levels[i, 1]=="N", 1, 16), col=ifelse(levels[i, 1]=="N", adjustcolor(threshcols[2], alpha.f = alpha2), threshcols22[2])) 
}
# adding sample sizes
n_group <- datasub %>% group_by(cov_inc, cov_sd) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(cov_sd, cov_inc) 
boxbnds <- boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = ifelse(boxbnds[nrow(boxbnds), ] + n_adj < ymax, boxbnds[nrow(boxbnds), ] + n_adj, boxbnds[nrow(boxbnds), ] + n_adj2), as.character(n_group$n), cex = n_size)


# add mini plot showing functional form
#mtext(side = 4, "SG", las = 2, padj = 5)
# plot border
x_L <- -0.3
x_R <- 0.5
y_B <- ymin
y_T <- ymin + 0.7
text(x = boxpos[length(boxpos)]-1.9, y = y_B + (y_T-y_B)/2, "SG", cex = 1.2)
rect(xleft = boxpos[length(boxpos)-1] + x_L, ybottom= y_B, xright = boxpos[length(boxpos)] + x_R, ytop = y_T, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)-1] + x_L, to = boxpos[length(boxpos)] + x_R, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
# y vals for real-size function: make these range from  0 to 1
big_y <- 1/(1 + exp(-6*(big_x-mini_x[length(mini_x)/1.9])))
mini_y <- (y_T - y_B)*big_y + y_B # now squish the yvalues to fit in the mini plot (which has a yrange of ybottom to ytop in the rect function) and shift them to line up w/ the lower border of the plot
lines(x = mini_x, y = mini_y, type = "l") 


# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# middle row: skew
plot_dt <- linexp_cov[which(linexp_cov$shape=="skew"),] %>% filter(best_mod %in% c("gam", "gam_DC", "gam_DCl")) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)%>% filter(thresh_method=="zero_d1")
#View(plot_dt)
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(cov_inc, obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)
plot_dt$thresh_diff <- ifelse(plot_dt$cov_sd==0 & plot_dt$cov_inc=="Y", -9999, plot_dt$thresh_diff)


################ linear cov ####################
levels <- matrix(NA, nrow = 6, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("N", "Y"), 3)
levels[,2] <- rep(c("0", "0.5", "1"), each = 2)

datasub <- plot_dt %>% filter(cov_type=="linear") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,
        at = boxpos, col = c(adjustcolor(threshcols[3], alpha.f = 0), adjustcolor(threshcols[3], alpha.f = 0.3)), border = threshcols[3], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 3, "Linear covariate", line = 0)
mtext(side = 2, "Bias (mean estimate - true threshold)", line = 2) 
abline(h = 0, lty = 2)
#text(x = 6.4, y = 2.8, "risk-averse \nside")
#text(x = 6.4, y = -2.5, "risk-prone \nside")

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$cov_inc==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$cov_inc==levels[i,1] & datasub$cov_sd==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=ifelse(levels[i, 1]=="N", 1, 16), col=ifelse(levels[i, 1]=="N", adjustcolor(threshcols[3], alpha.f = alpha2), threshcols22[3])) 
}
# adding sample sizes
n_group <- datasub %>% group_by(cov_inc, cov_sd) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(cov_sd, cov_inc) 
boxbnds <- boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = ifelse(boxbnds[nrow(boxbnds), ] + n_adj < ymax, boxbnds[nrow(boxbnds), ] + n_adj, boxbnds[nrow(boxbnds), ] + n_adj2), as.character(n_group$n), cex = n_size)



################ exponential cov ####################
levels <- matrix(NA, nrow = 6, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("N", "Y"), 3)
levels[,2] <- rep(c("0", "0.5", "1"), each = 2)

datasub <- plot_dt %>% filter(cov_type=="exp") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,
        at = boxpos, col = c(adjustcolor(threshcols[3], alpha.f = 0), adjustcolor(threshcols[3], alpha.f = 0.3)), border = threshcols[3], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
#axis(side = 1, at = c(2.5, 8.5, 14.5), labels = c("15", "25", "35"), tick = F, line = -1)
#mtext(side = 3, "Exponential covariate", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$cov_inc==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$cov_inc==levels[i,1] & datasub$cov_sd==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=ifelse(levels[i, 1]=="N", 1, 16), col=ifelse(levels[i, 1]=="N", adjustcolor(threshcols[3], alpha.f = alpha2), threshcols22[3])) 
}
# adding sample sizes
n_group <- datasub %>% group_by(cov_inc, cov_sd) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(cov_sd, cov_inc) 
boxbnds <- boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = ifelse(boxbnds[nrow(boxbnds), ] + n_adj < ymax, boxbnds[nrow(boxbnds), ] + n_adj, boxbnds[nrow(boxbnds), ] + n_adj2), as.character(n_group$n), cex = n_size)


# add mini plot showing functional form
#mtext(side = 4, "SK", las = 2, padj = 5)
x_L <- -0.3
x_R <- 0.5
y_B <- ymin
y_T <- ymin + 0.7
text(x = boxpos[length(boxpos)]-1.9, y = y_B + (y_T-y_B)/2, "SK", cex = 1.2)
rect(xleft = boxpos[length(boxpos)-1] + x_L, ybottom= y_B, xright = boxpos[length(boxpos)] + x_R, ytop = y_T, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)-1] + x_L, to = boxpos[length(boxpos)] + x_R, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
#big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-5, to = mini_x[length(mini_x)/1.9] + 5, length.out = 1000) # if you don't see enough of the curve, need to make the limits on big_x larger
big_y <- dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)/max(dgamma(big_x, shape = mini_x[length(mini_x)/2] + 1, scale = 1)) # mode is at (shape -1 )*scale
#mini_y <- (-1.26 + 2.25)*big_y-2.25
mini_y <- (y_T - y_B)*big_y + y_B - 0.075 # make top of peak a little lower
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border



# <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- <- 

# bottom row: hockeystick
plot_dt <- linexp_cov[which(linexp_cov$shape=="hockeystick"),] %>% filter(best_mod %in% c("gam", "gam_DC", "gam_DCl")) %>% filter(thresh_n_full %in% c(1, NA)) %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh)%>% filter(thresh_method=="abs_max_d2")
# need to make dummy points for cases where results for all simulations were NA in order to keep the placeholder for the boxplot
plot_dt <- plot_dt %>% group_by(cov_inc, obs_error, ts_length, cov_sd, thresh_quant) %>% mutate(na_check = mean(thresh_diff, na.rm = T)) %>% ungroup() 
plot_dt$thresh_diff <- ifelse(is.na(plot_dt$na_check)==T, -9999, plot_dt$thresh_diff)
plot_dt$thresh_diff <- ifelse(plot_dt$cov_sd==0 & plot_dt$cov_inc=="Y", -9999, plot_dt$thresh_diff)


################ linear cov ####################
levels <- matrix(NA, nrow = 6, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("N", "Y"), 3)
levels[,2] <- rep(c("0", "0.5", "1"), each = 2)

datasub <- plot_dt %>% filter(cov_type=="linear") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,
        at = boxpos, col = c(adjustcolor(threshcols[1], alpha.f = 0), adjustcolor(threshcols[1], alpha.f = 0.3)), border = threshcols[1], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = c(1.5, 5.5, 9.5), labels = c("0", "0.5", "1"), tick = F, line = -1)
mtext(side = 1, "Covariate sd", line = 1.2, cex = xlab_cex)
#mtext(side = 3, "Linear covariate", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
#text(x = 6.4, y = 2.8, "risk-averse \nside")
#text(x = 6.4, y = -2.5, "risk-prone \nside")

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$cov_inc==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$cov_inc==levels[i,1] & datasub$cov_sd==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=ifelse(levels[i, 1]=="N", 1, 16), col=ifelse(levels[i, 1]=="N", adjustcolor(threshcols[1], alpha.f = alpha2), threshcols22[1])) 
}
# adding sample sizes
n_group <- datasub %>% group_by(cov_inc, cov_sd) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(cov_sd, cov_inc) 
boxbnds <- boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = ifelse(boxbnds[nrow(boxbnds), ] + n_adj < ymax, boxbnds[nrow(boxbnds), ] + n_adj, boxbnds[nrow(boxbnds), ] + n_adj2), as.character(n_group$n), cex = n_size)


################ exponential cov ####################
levels <- matrix(NA, nrow = 6, ncol = 2) # levels for jittering points
levels[, 1] <- rep(c("N", "Y"), 3)
levels[,2] <- rep(c("0", "0.5", "1"), each = 2)

datasub <- plot_dt %>% filter(cov_type=="exp") #%>% distinct()
#View(datasub)
boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,
        at = boxpos, col = c(adjustcolor(threshcols[1], alpha.f = 0), adjustcolor(threshcols[1], alpha.f = 0.3)), border = threshcols[1], outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = c(1.5, 5.5, 9.5), labels = c("0", "0.5", "1"), tick = F, line = -1)
mtext(side = 1, "Covariate sd", line = 1.2, cex = xlab_cex)
#mtext(side = 3, "Exponential covariate", line = 0)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)

for(i in 1:nrow(levels)){
  #prop <- length(datasub$sim[which(datasub$cov_inc==levels[i,1])]/nrow(datasub))
  yvals <- datasub$thresh_diff[which(datasub$cov_inc==levels[i,1] & datasub$cov_sd==as.numeric(levels[i, 2]))] 
  jtx <- jitter(rep(boxpos[i], length(yvals)), amount = jt_amount)# add jitter to x-axis indices proportional number in each level
  points(jtx, yvals, pch=ifelse(levels[i, 1]=="N", 1, 16), col=ifelse(levels[i, 1]=="N", adjustcolor(threshcols[1], alpha.f = alpha2), threshcols22[1])) 
}
# adding sample sizes
n_group <- datasub %>% group_by(cov_inc, cov_sd) %>% summarize(n = length(which(is.na(thresh_diff)==F))) %>% arrange(cov_sd, cov_inc) 
boxbnds <- boxplot(thresh_diff ~ cov_inc + as.character(cov_sd), data = datasub,at = boxpos, plot = F)$stats 
text(x = boxpos, y = ifelse(boxbnds[nrow(boxbnds), ] + n_adj < ymax, boxbnds[nrow(boxbnds), ] + n_adj, boxbnds[nrow(boxbnds), ] + n_adj2), as.character(n_group$n), cex = n_size)


# add mini plot showing functional form
x_L <- -0.3
x_R <- 0.5
y_B <- ymin
y_T <- ymin + 0.7
text(x = boxpos[length(boxpos)]-1.9, y = y_B + (y_T-y_B)/2, "HS", cex = 1.2)
rect(xleft = boxpos[length(boxpos)-1] + x_L, ybottom= y_B, xright = boxpos[length(boxpos)] + x_R, ytop = y_T, border = "black")
# x vals for the mini plot
mini_x <- seq(from = boxpos[length(boxpos)-1] + x_L, to = boxpos[length(boxpos)] + x_R, length.out = 1000)
# x vals for the real-size function: go from the left to the right of the threshold (which is approximately the middle of mini_x, here make it a little less than the middle - divide by 1.9 instead of 2)
#big_x <- seq(from = mini_x[length(mini_x)/1.9]-1, to = mini_x[length(mini_x)/1.9] + 1, length.out = 1000)
big_x <- seq(from = mini_x[length(mini_x)/1.9]-8, to = mini_x[length(mini_x)/1.9] + 8, length.out = 1000)
y_low <- 0
big_y <- ifelse(big_x < 0, y_low, ifelse(big_x < mini_x[length(mini_x)/2], (0.9-y_low)/ (mini_x[length(mini_x)/2] - y_low) * (big_x - mini_x[length(mini_x)/2]) + 0.9, 0.9))
#mini_y <- (-1.25 + 2.25)*big_y-2.25
mini_y <- (y_T - y_B)*big_y + y_B
lines(x = mini_x, y = mini_y, type = "l") # -1.22 to go a little below the border

# plot 10: dummy plot for legend
plot(0,type='n',axes=FALSE, ann = FALSE)
legend(0.8, 0.2, col = threshcols[1:3], pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0"), bty = "n", ncol =4, cex = 1.1, xpd = TRUE, inset = c(0,-0.5)) #, title = "Threshold calculation method"
text(0.75, -0.4, "Threshold def.", xpd = TRUE)

dev.off()

```



## ROC

reciever-operator curves looking at true and false positive rates of threshold detection when a covariate is or isn't included in the estimation models

top row = cov not included (with shading indicating value of cov sd), bottom row = showing difference from top row when cov is included -- so bottom row will have 4 quadrats, and would want to be in (neg,pos) quadrat -> decrease in FPR and increase in TPR


true positive = chose the gam or gam_DC or gam_DCl with AIC > 2 when true driver-response function was nonlinear

false positive = chose the gam or gam_DC or gam_DCl with AIC > 2 when true driver-response function was linear
- note choosing gam_DlC (= linear driver and nonlinear covariate) over the other gams is not a false positive when the true driver-response relationship is linear

```{r}

#View(focal_df)

#unique(linexp_cov$cov_sd)

# subset out the data and adjust the number of thresholds detected across the jackknife iterations (thresh_n) by saying it is zero if the best model fit to the full data did not have a nonlinear driver-response relationship
data_sub <- linexp_cov %>% filter(sig_type=="none")%>% mutate(thresh_n = if_else(best_mod %in% c("lm", "lm_ns", "lm_DC", "lm_DC_ns", "gam_ns", "gam_DC_ns", "gam_DlC_ns", "gam_DCl_ns", "gam_DlC"), 0, thresh_n))%>% mutate(thresh_fraction = thresh_n/ts_length) %>% mutate(thresh_fraction = if_else(thresh_n_full %in% c(NA, 1), thresh_fraction, 0))

#View(data_sub)

# false positives
fpr_df <- data_sub %>% filter(shape=="linear") %>% mutate(n_sims = if_else(thresh_fraction >= 0.25, 1, 0)) %>% group_by(thresh_method, cov_sd, cov_type, cov_val, cov_inc) %>% summarize(FPR = sum(n_sims)/100) %>% ungroup()

#View(fpr_df)

# true positives
tpr_df <- data_sub %>% filter(shape !="linear") %>% mutate(n_sims = if_else(thresh_fraction >= 0.25, 1, 0)) %>% group_by(shape, thresh_method, cov_sd, cov_type, cov_val, cov_inc) %>% summarize(TPR = sum(n_sims)/100) %>% ungroup()

# join together
roc_cov_df <- left_join(tpr_df, fpr_df, by = c("thresh_method", "cov_sd", "cov_type", "cov_val", "cov_inc"))

#View(fpr_df)

#View(roc_cov_df)

# split up the results for simulations where the cov was vs wan't included in the estimation models and join back together
roc_covN_df <- roc_cov_df %>% filter(cov_inc=="N") %>% rename(TPR_N = TPR, FPR_N = FPR) %>% select(-cov_val, -cov_inc)
roc_covY_df <- roc_cov_df %>% filter(cov_inc=="Y") %>% rename(TPR_Y = TPR, FPR_Y = FPR) %>% select(-cov_val, -cov_inc)

roc_cov_df2 <- left_join(roc_covN_df, roc_covY_df, by = c("shape","thresh_method", "cov_sd", "cov_type")) %>% mutate(TPR_diff = TPR_Y - TPR_N, FPR_diff = FPR_Y - FPR_N) # calculate difference in TPRs and FPRs when cov was vs. wasn't included in the estimation models

#View(roc_cov_df2)

```


check what the next best model was in the cases where change in FPR was > 0 (i.e., cases where the FPR increased when the covariate was added to the estimation models)

```{r}

fpr_check <- data_sub %>% filter(shape=="linear") %>% filter(cov_type=="exp" & cov_inc == "Y" & thresh_fraction >= 0.25 & cov_sd > 0) %>% filter(thresh_method != "zero_d2")

#View(fpr_check)

unique(fpr_check$next_mod) # all were gam_DlC

#mean(fpr_check$aic_diff)
#hist(fpr_check$aic_diff)

quantile(fpr_check$aic_diff, 0.5) # 50% of AIC differences between best and next-best models were less than 3.5


```


make the plot

```{r}

pt_alpha <- c(0, 0.4, 1) # point transparency

#cov_sd_set2 <- c(0, 0.5, 1)

#shape_types <- c("skew", "sigmoidal", "hockeystick")

plot_df <- roc_cov_df %>% mutate(shape.method = paste(shape, thresh_method, sep = ".")) %>% filter(shape.method %in% c("skew.zero_d1", "sigmoidal.min_d2", "hockeystick.abs_max_d2")) # only want to plot the results for the best threshold definitions for each driver-response relationship

shape.methods <- unique(plot_df$shape.method)
#shape.methods # hockey stick, sigmoidal, skew

pt_cols <- c("purple", "forestgreen", "orange")
pt_pch <- c(15, 17, 16) # skew, sig, hs
pt_out <- c(0, 2, 1) # outlines

pdf("figurepdfs/Cov_ROC_linexp.pdf", width = 5, height = 4.6)#width = 6.5, height = 2.5
par(mfrow = c(2, 2))
layout(matrix(c(1, 3, 2, 4), nrow = 2, ncol = 2), widths = c(1, 1), heights = c(1, 1))
#par(mar=c(2, 2, 0.5, 0), oma = c(1, 2, 1.2, 3))
par(mar=c(2.5, 1.25, 1, 0), oma = c(2.2, 3, 1.2, 0.5))

dt_sub <- plot_df %>% filter(cov_type=="linear") %>% filter(cov_inc=="N") %>% arrange(cov_sd)

# linear cov
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 1), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 1, at = seq(from = 0, to = 1, by = 0.2))
axis(side = 2, at = seq(from = 0, to = 1, by = 0.2), las = 1)
mtext(side = 2, "True positive rate", line = 2.5)
mtext(side = 1, "False positive rate", line = 2)
mtext(side = 3, "Linear covariate", line = 0)
abline(a = 0, b = 1, lty = 2)
for(i in 1:length(shape.methods)){
for(j in 1:length(cov_sd_set2)){
points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}
# legend background
legend("bottomright", legend = c("0", "0.5", "1"), col = c("gray30", adjustcolor("gray30", alpha.f = 0.4), "gray30"), pch = c(1, 16, 16), title = "Cov. sd", bg = "white")
legend("bottomright", legend = c("0", "0.5", "1"), col = c("gray30", "gray30", "gray30"), pch = c(1, 1, 1), title = "Cov. sd")#, bty = "n"

# exponential cov
dt_sub <- plot_df %>% filter(cov_type=="exp") %>% filter(cov_inc=="N") %>% arrange(cov_sd)

# exp cov
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 1), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 1, at = seq(from = 0, to = 1, by = 0.2))
axis(side = 2, at = seq(from = 0, to = 1, by = 0.2), labels = NA)
#mtext(side = 2, "True positive rate", line = 2.5)
mtext(side = 1, "False positive rate", line = 2)
mtext(side = 3, "Exponential covariate", line = 0)
abline(a = 0, b = 1, lty = 2)
for(i in 1:length(shape.methods)){
for(j in 1:length(cov_sd_set2)){
points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}
#rect(xleft=0.38, ybottom = 0.41, xright = 1.1, ytop = 1.1, col = "white", border = NA)
legend("topright", legend = c("SG, min(s''(x))", "SK, s'(x)=0","HS, max(|s''(x)|)"), col = c("forestgreen", "orange", "purple"), pch = c(17, 16, 15), title = "Shape, threshold", bg = "white")#, , bty = "n",bg = "white"

# now plot the differences
plot_df <- roc_cov_df2 %>% mutate(shape.method = paste(shape, thresh_method, sep = ".")) %>% filter(shape.method %in% c("skew.zero_d1", "sigmoidal.min_d2", "hockeystick.abs_max_d2"))

ymin <- min(roc_cov_df2$TPR_diff)
ymax <- max(roc_cov_df2$TPR_diff)
xmin <- min(roc_cov_df2$FPR_diff)
xmax <- max(roc_cov_df2$FPR_diff)

xymin <- min(xmin, ymin)
xymax <- max(xmax, ymax)

dt_sub <- plot_df %>% filter(cov_type=="linear") %>% arrange(cov_sd)

plot(x = 0, y = 0, ylim = c(xymin, xymax), xlim = c(xymin, xymax), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
#axis(side = 1, at = seq(from = xymin, to = xymax, by = 0.2))
#axis(side = 2, at = seq(from = xymin, to = xymax, by = 0.2), las = 1)
axis(side = 1, at = seq(from = -1, to = 0.7, by = 0.2))
axis(side = 2, at = seq(from = -1, to = 0.7, by = 0.2), las = 1)
mtext(side = 2, "Difference in TPR", line = 2.5)
mtext(side = 1, "Difference in FPR", line = 2)
#mtext(side = 3, "Linear covariate", line = 0)
abline(h = 0, lty = 2)
abline(v = 0, lty = 2)
abline(a = 0, b = 1, lty = 2)
for(i in 1:length(shape.methods)){
for(j in 1:length(cov_sd_set2)){
points(x = dt_sub$FPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}

dt_sub <- plot_df %>% filter(cov_type=="exp") %>% arrange(cov_sd)

plot(x = 0, y = 0, ylim = c(xymin, xymax), xlim = c(xymin, xymax), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
#axis(side = 1, at = seq(from = xymin, to = xymax, by = 0.2))
#axis(side = 2, at = seq(from = xymin, to = xymax, by = 0.2), labels = NA)
axis(side = 1, at = seq(from = -1, to = 0.7, by = 0.2))
axis(side = 2, at = seq(from = -1, to = 0.7, by = 0.2), labels = NA)
#mtext(side = 2, "Difference in TPR", line = 2.5)
mtext(side = 1, "Difference in FPR", line = 2)
#mtext(side = 3, "Linear covariate", line = 0)
abline(h = 0, lty = 2)
abline(v = 0, lty = 2)
abline(a = 0, b = 1, lty = 2)
for(i in 1:length(shape.methods)){
for(j in 1:length(cov_sd_set2)){
points(x = dt_sub$FPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], y = dt_sub$TPR_diff[which(dt_sub$shape.method==shape.methods[i]&dt_sub$cov_sd==cov_sd_set2[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}

dev.off()


```


note the FPRs only depend on the threshold definition, not the non-linear driver-response relationship (since the FPRs are from when the true driver-response relationship is linear)


# false positives

plot the fraction of simulations that detected a threshold when the true driver-response relationship was linear

### default parameters

% of linear simulations that detected a threshold
```{r}
# only have one function so only one row, and then have 3 columns for the 3 parameters

max_adj <- 0.5 # adjust ymax 

xlab_cex <- 0.75 # size to make x axis labels
col_cex <- 1.2 # font for column labels


thresh_methods <- c("abs_max_d2", "min_d2", "zero_d1", "zero_d2")

plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(sig_type==sig_choice) %>% filter(thresh_fraction >= sig_thresh) %>% filter(thresh_method != "zero_d2")

ymin <- -0.05
ymax <- 1#max(unique(plot_dt$sim))
yaxt_at <- seq(from = 0, to = ymax, by = 0.2)# where to put y axis labels
ylabs <- seq(from = 0, to = ymax, by = 0.2)


pdf("figurepdfs/S_FocalLin.pdf", width = 6.5, height = 2.5)
par(mfrow = c(1, 3))
layout(matrix(c(1, 2, 3), nrow = 1, ncol = 3), widths = c(1, 1, 1), heights = c(1))
#par(mar=c(2, 2, 0.5, 0), oma = c(1, 2, 1.2, 3))
par(mar=c(2, 0.5, 0.5, 0), oma = c(1, 4.25, 1.2, 1))
# linear
plot_dt <- focal_df[which(focal_df$shape=="linear"),] %>% filter(best_mod=="gam") %>%  filter(sig_type==sig_choice) %>% mutate(thresh_fraction = if_else(thresh_n_full==0, 0, thresh_fraction))%>% filter(thresh_method != "zero_d2") #%>% filter(thresh_n_full %in% c(1, NA))%>% %>% filter(thresh_fraction >= sig_thresh) 
#View(plot_dt)

################ effect of ts length ####################

datasub <- plot_dt %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
#datasub2 <- datasub %>% filter(thresh_detected=="y") %>% group_by(thresh_method, ts_length) %>% summarize(n_sims = n()) %>% arrange(ts_length)
datasub2 <- datasub %>% mutate(n_sims = if_else(thresh_fraction >= sig_thresh, 1, 0)) %>% group_by(thresh_method, ts_length) %>% summarize(n_sims = sum(n_sims)) %>% mutate(FPR = n_sims/100) %>% arrange(ts_length)
#View(datasub2)
plot(x = datasub2$ts_length[which(datasub2$thresh_method==thresh_methods[1])], y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[1])], xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", pch = 16, col = threshcols[1], type = "o")
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = ts_set, labels = ts_set, tick = T)#, line = -1
#mtext(side = 2, "No. of simulations that detected threshold", cex = xlab_cex, line = 2)#, line = -1
mtext(side = 2, "Fraction of simulations \nthat detected a threshold", cex = xlab_cex, line = 2.25)
mtext(side = 3, "Time series length", line = 0)
mtext(side = 1, "Time series length", line = 1.75, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
abline(h = 1, lty = 2)
text(x = 18.5, y = -0.04, "FPR = 0")
text(x = 18.5, y = 0.95, "FPR = 100%")
for(i in 2:4){ # 4 threshold detection methods
 lines(x = datasub2$ts_length[which(datasub2$thresh_method==thresh_methods[i])], y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[i])], pch = 16, col = ifelse(datasub2$thresh_method[i]=="abs_max_d2", threshcols[1], ifelse(datasub2$thresh_method[i]=="min_d2", threshcols[2], ifelse(datasub2$thresh_method[i]=="zero_d1", threshcols[3], threshcols[4]))), type = "o")
  
}


################ effect of obs error ####################
datasub <- plot_dt %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
datasub2 <- datasub %>% mutate(n_sims = if_else(thresh_fraction >= sig_thresh, 1, 0)) %>% group_by(thresh_method, obs_error) %>% summarize(n_sims = sum(n_sims))%>% mutate(FPR = n_sims/100) %>% arrange(obs_error)

#View(datasub)
#boxplot(thresh_mean ~ as.character(obs_error), data = datasub,
        #at = boxpos, col = NA, border = NA, outline = F, names = NA, xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n")
plot(x = datasub2$obs_error[which(datasub2$thresh_method==thresh_methods[1])], y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[1])], xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", pch = 16, col = threshcols[1], type = "o")
axis(side = 2, at = yaxt_at, labels = NA)
axis(side = 1, at = obs_set, labels = c("0.01", "0.2", "1"), tick = T)
mtext(side = 3, "Observation error", line = 0)
mtext(side = 1, "CV (approx.)", line = 1.75, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
abline(h = 1, lty = 2)
for(i in 2:4){ # 4 threshold detection methods
 lines(x = datasub2$obs_error[which(datasub2$thresh_method==thresh_methods[i])], y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[i])], pch = 16, col = ifelse(datasub2$thresh_method[i]=="abs_max_d2", threshcols[1], ifelse(datasub2$thresh_method[i]=="min_d2", threshcols[2], ifelse(datasub2$thresh_method[i]=="zero_d1", threshcols[3], threshcols[4]))), type = "o")
  
}


################ effect of threshold quantile ####################
datasub <- plot_dt %>% filter(ts_length==ts_set[2], obs_error == obs_set[2], cov_sd == cov_sd_set2[1]) #%>% distinct()
#View(datasub)
datasub2 <- datasub %>% mutate(n_sims = if_else(thresh_fraction >= sig_thresh, 1, 0)) %>% group_by(thresh_method, thresh_quant) %>% summarize(n_sims = sum(n_sims))%>% mutate(FPR = n_sims/100) %>% arrange(thresh_quant)

plot(x = datasub2$thresh_quant[which(datasub2$thresh_method==thresh_methods[1])], y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[1])], xaxt = "n", las = 1, xlab = NA, ylab = NA, ylim = c(ymin, ymax), yaxt = "n", pch = 16, col = threshcols[1], type = "o")
axis(side = 2, at = yaxt_at, labels = NA)
#mtext(side = 4, "SG", las = 2)
axis(side = 1, at = quant_set, labels = c("0.05", "0.25", "0.5"), tick = T)
mtext(side = 3, "Threshold quantile", line = 0)
mtext(side = 1, "Threshold quantile", line = 1.75, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
abline(h = 1, lty = 2)
for(i in 2:4){ # 4 threshold detection methods
 lines(x = datasub2$thresh_quant[which(datasub2$thresh_method==thresh_methods[i])], y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[i])], pch = 16, col = ifelse(datasub2$thresh_method[i]=="abs_max_d2", threshcols[1], ifelse(datasub2$thresh_method[i]=="min_d2", threshcols[2], ifelse(datasub2$thresh_method[i]=="zero_d1", threshcols[3], threshcols[4]))), type = "o")
  
}
#legend(x = 0.3, y = 0.95, col = threshcols, pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), bty = "n", ncol =1, title = "Threshold \ndefinition")
legend(x = 0.3, y = 0.95, col = threshcols[1:3], pch = 16, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0"), bty = "n", ncol =1, title = "Threshold \ndefinition")

dev.off()



```

### compare sig criteria

repeat the above but for each of the three significance criteria (none, jackknifed quantiles, and simultanous intervals)

```{r}

max_adj <- 0.5 # adjust ymax 


xlab_cex <- 1 # size to make x axis labels
col_cex <- 1.2 # font for column labels

thresh_methods <- c("abs_max_d2", "min_d2", "zero_d1", "zero_d2")

thresh_methods_x <- c(1, 2, 3, 4) # x locations

sig_pch <- c(4, 7, 9) # point types for different significance criteria: none, jack_quant sim_int

jt_amount1 <- 0.2
pt_jt1 <- c(-jt_amount1, 0, jt_amount1) # amount to shift the points for the different thresh calculation methods so they aren't all on top of each other

plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(shape=="linear") %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) 

ymin <- -0.05
ymax <- 1#max(unique(plot_dt$sim))
yaxt_at <- seq(from = 0, to = 1, by = 0.2)# where to put y axis labels
ylabs <- seq(from = 0, to = 1, by = 0.2)

pdf("figurepdfs/S_SigLin.pdf", width = 5, height = 4)
par(mar=c(2, 2, 0.5, 0), oma = c(1, 3, 1.2, 0.5))
# linear
plot_dt <- focal_df %>% filter(best_mod=="gam") %>% filter(shape=="linear")%>% mutate(thresh_fraction = if_else(thresh_n_full %in% c(NA, 1), thresh_fraction, 0)) %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) 

datasub <- plot_dt #%>% filter(sig_type=="none") #%>% distinct()
datasub2 <- datasub %>% mutate(n_sims = if_else(thresh_fraction >= sig_thresh, 1, 0)) %>% group_by(thresh_method, sig_type) %>% summarize(n_sims = sum(n_sims)) %>% mutate(FPR = n_sims/100) %>% mutate(sig_sort = if_else(sig_type=="none", 1, if_else(sig_type=="jack_quant", 2, 3))) %>% arrange(thresh_method, sig_sort)
#View(datasub2)
plot(x = thresh_methods_x[1] + pt_jt1, y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[1])], xaxt = "n", las = 1, xlab = NA, ylab = NA, xlim = c(thresh_methods_x[1]-jt_amount1, thresh_methods_x[4]+jt_amount1), ylim = c(ymin, ymax), yaxt = "n", pch = sig_pch, col = threshcols[1], type = "p")
axis(side = 2, at = yaxt_at, las = 1)
axis(side = 1, at = thresh_methods_x, labels = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), tick = T)
#axis(side = 1, at = thresh_methods_x, labels = thresh_methods, tick = T)#, line = -1
#mtext(side = 2, "No. of simulations that detected threshold", cex = xlab_cex, line = 2)#, line = -1
mtext(side = 2, "Fraction of simulations \nthat detected a threshold", cex = xlab_cex, line = 2.25)
mtext(side = 3, "Effect of significance criteria on false positive rate", line = 0)
mtext(side = 1, "Threshold definition", line = 2, cex = xlab_cex)
#mtext(side = 2, "Mean estimate - true threshold", line = 2) 
abline(h = 0, lty = 2)
abline(h = 1, lty = 2)
text(x = 1, y = -0.03, "FPR = 0")
text(x = 1.1, y = 0.95, "FPR = 100%")
for(i in 2:4){ # 4 threshold detection methods
 lines(x = thresh_methods_x[i]+ pt_jt1, y = datasub2$FPR[which(datasub2$thresh_method==thresh_methods[i])], pch = sig_pch, col = ifelse(thresh_methods[i]=="abs_max_d2", threshcols[1], ifelse(thresh_methods[i]=="min_d2", threshcols[2], ifelse(thresh_methods[i]=="zero_d1", threshcols[3], threshcols[4]))), type = "p")
  
}
legend(x = 3, y = 0.9, legend = c("none", "jack_quant", "sim_int"), pch = sig_pch, col = "gray40", title = "Significance \ncriteria", bty = "n")

dev.off()

```



# more ROC plots

ROC plots for simulations without any covariate effect on the response

### sig criteria

show the effect of 1) significance criteria (none, jackknife quantiles, or simultaneous intervals) and 2) the min fraction of jackknife iterations required to detect a threshold for positive detection on TPRs and FPRs

first format the data
```{r}

#sig_thresh_set <- seq(from = 0.1, to = 1, by = 0.1)
sig_thresh_set <- seq(from = 0.25, to = 1, by = 0.25) # min fractions of jackknife iterations required to detect a threshold

plot_dt <- focal_df %>% filter(ts_length ==ts_set[2], obs_error==obs_set[2], thresh_quant == quant_set[2], cov_sd == cov_sd_set2[1]) %>% mutate(thresh_n = if_else(best_mod %in% c("lm", "lm_ns", "gam_ns"), 0, thresh_n)) %>% mutate(thresh_fraction = thresh_n/ts_length) %>% mutate(thresh_fraction = if_else(thresh_n_full %in% c(NA, 1), thresh_fraction, 0))
#View(plot_dt)

for(jj in 1:length(sig_thresh_set)){ # for each min fraction
  
  sig_threshjj <- sig_thresh_set[jj]
  
  # get the FPRs for the different significance criteria
dt_jj <- plot_dt %>% filter(shape=="linear") %>% mutate(n_sims = if_else(thresh_fraction >= sig_threshjj, 1, 0)) %>% group_by(sig_type, thresh_method) %>% summarize(FPR = sum(n_sims)/100)

dt_jj$sig_thresh <- rep(sig_threshjj, length(dt_jj$thresh_method))

#View(dt_jj)

if(jj==1){
  fpr_df <- dt_jj
} else{
  
  fpr_df <- rbind(dt_jj, fpr_df)
  
}

}

#View(fpr_df)


# repeat for TPR calculations
for(jj in 1:length(sig_thresh_set)){
  
  sig_threshjj <- sig_thresh_set[jj]
  
dt_jj <- plot_dt %>% filter(shape !="linear") %>% mutate(n_sims = if_else(thresh_fraction >= sig_threshjj, 1, 0)) %>% group_by(shape, sig_type, thresh_method) %>% summarize(TPR = sum(n_sims)/100)

dt_jj$sig_thresh <- rep(sig_threshjj, length(dt_jj$thresh_method))

#View(dt_jj)

if(jj==1){
  tpr_df <- dt_jj
} else{
  
  tpr_df <- rbind(dt_jj, tpr_df)
  
}

}

#View(tpr_df)

# put everything together
roc_df <- left_join(tpr_df, fpr_df, by = c("sig_type", "thresh_method", "sig_thresh")) %>% arrange(match(sig_type, c("none", "jack_quant", "sim_int")), match(thresh_method, c("abs_max_d2", "min_d2", "zero_d1","zero_d2")), sig_thresh)

#View(roc_df)

#View(roc_df[which(roc_df$shape=="hockeystick"),])

#View(roc_df[which(roc_df$shape=="hockeystick" & roc_df$thresh_method=="zero_d1"),])

```



```{r}

#View(roc_df)

sig_pch <- c(1,1, 1) # point types for different sig criteria (none, jack_quant sim_int)
sig_pch_out <- c(NA, NA, NA) # jack_quant, none, sim_int point outlines

sig_cex <- c(0.25, 0.5, 0.75, 1)*1.1

sig_types <- unique(roc_df$sig_type)
#sig_types # jack_quant, none, sim_int
thresh_methods <- unique(roc_df$thresh_method)

lab_adj <- 0.01 # adjust x position of point label

#thresh_methods

pdf("figurepdfs/ROC_default.pdf", width = 4.5, height= 5.5)
par(mfrow = c(4, 3))
layout(matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3, ncol = 3), widths = c(1, 1, 1), heights = c(1, 1, 1))
par(mar=c(0.1, 0.5, 0.5, 0), oma = c(3.5, 3.5, 1, 0.5))
#par(mar=c(2, 2, 0.5, 0), oma = c(2, 2, 1, 0.5))

# # # # # no sig criteria # # # #
k <- 1

data_sub <- roc_df %>% filter(shape=="sigmoidal") 
#View(data_sub)
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n")
axis(side = 1, at = seq(0, 1, by = 0.2), labels = NA)
#mtext(side = 1, "False positive rate", line = 2.5)
#mtext(side = 2, "True positive rate", line = 2.5)
mtext(side = 3, "None")
#points(x = 0, y = 1, pch = 8)
#text(x = 0, y = 1, "Perfect detection")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}

data_sub <- roc_df %>% filter(shape=="skew") 
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n")
axis(side = 1, at = seq(0, 1, by = 0.2), labels = NA)
mtext(side = 2, "True positive rate", line = 2.5)
#mtext(side = 3, "Skew vs. linear")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}

data_sub <- roc_df %>% filter(shape=="hockeystick") 
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n")
axis(side = 1, at = seq(0, 1, by = 0.2))
#mtext(side = 1, "False positive rate", line = 2.5)
#mtext(side = 2, "True positive rate", line = 2.5)
#mtext(side = 3, "Hockeystick vs. linear")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}


# # # # # jackk quant # # # #
k <- 2

data_sub <- roc_df %>% filter(shape=="sigmoidal") 
#View(data_sub)
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 2, at = seq(0, 1, by = 0.2), labels = NA)
axis(side = 1, at = seq(0, 1, by = 0.2), labels = NA)
#mtext(side = 1, "False positive rate", line = 2.5)
#mtext(side = 2, "True positive rate", line = 2.5)
mtext(side = 3, "Jackknifed")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}
legend(x ="topright", col = "gray50", pch = 1, legend = c("0.25", "0.5", "0.75", "1"), title = "Min. fraction", bg = "white", pt.cex=c(0.25, 0.5, 0.75, 1)*1.1, cex = 0.9)

data_sub <- roc_df %>% filter(shape=="skew") 
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 2, at = seq(0, 1, by = 0.2), labels = NA)
axis(side = 1, at = seq(0, 1, by = 0.2), labels = NA)
#mtext(side = 2, "True positive rate", line = 2.5)
#mtext(side = 3, "Skew vs. linear")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}

data_sub <- roc_df %>% filter(shape=="hockeystick") 
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 2, at = seq(0, 1, by = 0.2), labels = NA)
axis(side = 1, at = seq(0, 1, by = 0.2))
mtext(side = 1, "False positive rate", line = 2.5)
#mtext(side = 2, "True positive rate", line = 2.5)
#mtext(side = 3, "Hockeystick vs. linear")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}

# # # # # sim int # # # #
k <- 3

data_sub <- roc_df %>% filter(shape=="sigmoidal") 
#View(data_sub)
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 2, at = seq(0, 1, by = 0.2), labels = NA)
axis(side = 1, at = seq(0, 1, by = 0.2), labels = NA)
#mtext(side = 1, "False positive rate", line = 2.5)
#mtext(side = 2, "True positive rate", line = 2.5)
mtext(side = 3, "Simultaneous")
#points(x = 0, y = 1, pch = 8)
#text(x = 0, y = 1, "Perfect detection")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}
text(x = 0.3, y = 0.01, "Linear vs. SG")
legend(x ="topright", col = threshcols, pch = 1, legend = c("max(|s''(x)|)", "min(s''(x))", "s'(x)=0", "s''(x)=0"), title = "Threshold \ndefinition", bg = "white", cex=0.9)#bty = "n"
#legend(x = 0.22, y = 0.42, col = "grey40", pch = sig_pch, legend = c("none", "jack_quant", "sim_int"), title = "Significance \ncriteria", bg = "white")

data_sub <- roc_df %>% filter(shape=="skew") 
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 2, at = seq(0, 1, by = 0.2), labels = NA)
axis(side = 1, at = seq(0, 1, by = 0.2), labels = NA)
#mtext(side = 2, "True positive rate", line = 2.5)
#mtext(side = 3, "Skew vs. linear")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}
text(x = 0.3, y = 0.01, "Linear vs. SK")

data_sub <- roc_df %>% filter(shape=="hockeystick") 
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 0.4), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 2, at = seq(0, 1, by = 0.2), labels = NA)
axis(side = 1, at = seq(0, 1, by = 0.2))
#mtext(side = 1, "False positive rate", line = 2.5)
#mtext(side = 2, "True positive rate", line = 2.5)
#mtext(side = 3, "Hockeystick vs. linear")
abline(0, 1, lty = 2)
#for(k in 1:length(sig_types)){ # 3 types of sig criteria
  for(i in 1:length(thresh_methods)){
    for(j in 1:length(sig_thresh_set)){
      data_sub2 <- data_sub[which(data_sub$sig_thresh==sig_thresh_set[j] & data_sub$thresh_method==thresh_methods[i] & data_sub$sig_type==sig_types[k]),]
     points(x = data_sub2$FPR, y = data_sub2$TPR, pch = sig_pch[k], col = ifelse(i==1, threshcols[1], ifelse(i==2, threshcols[2], ifelse(i==3, threshcols[3], threshcols[4]))), cex = sig_cex[j])
    }
  }
#}
text(x = 0.3, y = 0.01, "Linear vs. HS")


dev.off()


# FPR = fraction linear that found a threshold
# FNR = fraction nonlinear that did not find a threshold

```


### par effects

ROC plots where the different points represent different combinations of simulation parameters


prep the data
```{r}

#View(focal_df)

data_sub <- focal_df %>% filter(sig_type=="none", cov_sd==0)%>% mutate(thresh_n = if_else(best_mod %in% c("lm", "lm_ns", "gam_ns"), 0, thresh_n))%>% mutate(thresh_fraction = thresh_n/ts_length) %>% mutate(thresh_fraction = if_else(thresh_n_full %in% c(NA, 1), thresh_fraction, 0))

fpr_df <- data_sub %>% filter(shape=="linear") %>% mutate(n_sims = if_else(thresh_fraction >= 0.25, 1, 0)) %>% group_by(thresh_method, obs_error, ts_length, thresh_quant) %>% summarize(FPR = sum(n_sims)/100)

tpr_df <- data_sub %>% filter(shape !="linear") %>% mutate(n_sims = if_else(thresh_fraction >= 0.25, 1, 0)) %>% group_by(shape, thresh_method, obs_error, ts_length, thresh_quant) %>% summarize(TPR = sum(n_sims)/100)

roc_df <- left_join(tpr_df, fpr_df, by = c("thresh_method", "obs_error", "ts_length", "thresh_quant"))


#View(roc_df)

#focal_df %>% filter(shape=="linear") %>% view()

```


```{r}
pt_alpha <- c(0, 0.4, 1) # point transparency

#shape_types <- c("skew", "sigmoidal", "hockeystick")

plot_df <- roc_df %>% mutate(shape.method = paste(shape, thresh_method, sep = ".")) %>% filter(shape.method %in% c("skew.zero_d1", "sigmoidal.min_d2", "hockeystick.abs_max_d2"))

shape.methods <- unique(plot_df$shape.method)
#shape.methods # hockey stick, sigmoidal, skew

pt_cols <- c("purple", "forestgreen", "orange")
pt_pch <- c(15, 17, 16) # skew, sig, hs
pt_out <- c(0, 2, 1) # outlines

pdf("figurepdfs/S_ROC_pars.pdf", width = 6, height = 2.31)#width = 6.5, height = 2.5
par(mfrow = c(1, 3))
layout(matrix(c(1, 2, 3), nrow = 1, ncol = 3), widths = c(1, 1, 1), heights = c(1))
#par(mar=c(2, 2, 0.5, 0), oma = c(1, 2, 1.2, 3))
par(mar=c(2, 1.25, 0.5, 0), oma = c(2.2, 3, 1.2, 0.5))

dt_sub <- plot_df %>% filter(obs_error==obs_set[2], thresh_quant == quant_set[2]) %>% arrange(ts_length)
# time series length
plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 1), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 1, at = seq(from = 0, to = 1, by = 0.2))
axis(side = 2, at = seq(from = 0, to = 1, by = 0.2), las = 1)
mtext(side = 2, "True positive rate", line = 2.5)
mtext(side = 3, "Time series length", line = 0)
abline(a = 0, b = 1, lty = 2)
for(i in 1:length(shape.methods)){
for(j in 1:length(ts_set)){
points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$ts_length==ts_set[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$ts_length==ts_set[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$ts_length==ts_set[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$ts_length==ts_set[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}
# legend background
#rect(xleft=0.4, ybottom = 0.65, xright = 1.1, ytop = 1.1, col = "white", border = NA) # for 6.5 x 2.5 dimensions
rect(xleft=0.4, ybottom = 0.56, xright = 1.1, ytop = 1.1, col = "white", border = NA)
legend("topright", legend = c("SG, min(s''(x))", "SK, s'(x)=0","HS, max(|s''(x)|)"), col = c("forestgreen", "orange", "purple"), pch = c(17, 16, 15), title = "Shape, threshold")#, , bty = "n",bg = "white"
legend("bottomright", legend = c("15", "25", "35"), col = c("gray30", adjustcolor("gray30", alpha.f = 0.4), "gray30"), pch = c(1, 16, 16), title = "Time series \nlength", bty = "n")
legend("bottomright", legend = c("15", "25", "35"), col = c("gray30", "gray30", "gray30"), pch = c(1, 1, 1), title = "Time series \nlength", bty = "n")

# obs error
dt_sub <- plot_df %>% filter(ts_length==ts_set[2], thresh_quant == quant_set[2]) %>% arrange(obs_error)

plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 1), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 1, at = seq(from = 0, to = 1, by = 0.2))
axis(side = 2, at = seq(from = 0, to = 1, by = 0.2), las = 1, labels = NA)
abline(a = 0, b = 1, lty = 2)
mtext(side = 1, "False positive rate", line = 2.5)
mtext(side = 3, "Observation error", line = 0)
for(i in 1:length(shape.methods)){
for(j in 1:length(obs_set)){
points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$obs_error==obs_set[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$obs_error==obs_set[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$obs_error==obs_set[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$obs_error==obs_set[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}
legend("bottomright", legend = c("0.01", "0.2", "1"), col = c("gray30", adjustcolor("gray30", alpha.f = 0.4), "gray30"), pch = c(1, 16, 16), title = "CV (approx.)", bty = "n")
legend("bottomright", legend = c("0.01", "0.2", "1"), col = c("gray30", "gray30", "gray30"), pch = c(1, 1, 1), title = "CV (approx.)", bty = "n")


# threshold quantile
dt_sub <- plot_df %>% filter(obs_error==obs_set[2],ts_length==ts_set[2]) %>% arrange(thresh_quant)

plot(x = 0, y = 0, ylim = c(0, 1), xlim = c(0, 1), type = "n", las = 1, xlab = NA, ylab = NA, xaxt = "n", yaxt = "n")
axis(side = 1, at = seq(from = 0, to = 1, by = 0.2))
axis(side = 2, at = seq(from = 0, to = 1, by = 0.2), las = 1, labels = NA)
abline(a = 0, b = 1, lty = 2)
mtext(side = 3, "Threshold quantile", line = 0)
for(i in 1:length(shape.methods)){
for(j in 1:length(quant_set)){
points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$thresh_quant==quant_set[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$thresh_quant==quant_set[j])], pch = pt_pch[i], col = adjustcolor(pt_cols[i], alpha.f = pt_alpha[j]))
  points(x = dt_sub$FPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$thresh_quant==quant_set[j])], y = dt_sub$TPR[which(dt_sub$shape.method==shape.methods[i]&dt_sub$thresh_quant==quant_set[j])], pch = pt_out[i], col = pt_cols[i], lwd = 1.1)
}  
}
legend("bottomright", legend = c("0.05", "0.25", "0.5"), col = c("gray30", adjustcolor("gray30", alpha.f = 0.4), "gray30"), pch = c(1, 16, 16), title = "Threshold \nquantile", bty = "n")
legend("bottomright", legend = c("0.05", "0.25", "0.5"), col = c("gray30", "gray30", "gray30"), pch = c(1, 1, 1), title = "Threshold \nquantile", bty = "n")


dev.off()


```


# peaks and roots

supplemental figures showing how peaks (max and mins) and roots (zero-crossings) in the GAM derivatives are defined/selected


```{r}

# sequence of x values for example relationship
x_seq <- c(seq(from = -3.1, to = -2, by = 0.1), seq(from = -1.9, to = 5, by = 0.1))

pk_cex <- 2

pk_col <- "green3"

lnpt_cex <- 1

set.seed(101)
noise_set <- rep(1.6, length(seq(from = -3.1, to = -2, by = 0.1))) + rnorm(length(seq(from = -3.1, to = -2, by = 0.1)), 0, 0.1)

y_seq <- c(noise_set, c(0.1*(seq(from = -1.9, to = 5, by = 0.1)-2)^2)) - 0.5 # corresponding y values for example relationship: smooth curve with noise at the beginning

pks11 <- c(findpeaks(y_seq)[,2], findpeaks(-y_seq)[,2])
pks12 <- c(findpeaks(y_seq, nups = 3)[,2], findpeaks(-y_seq, nups = 3)[,2])

pdf("figurepdfs/d_min.pdf", width = 8, height = 3)
par(mfrow = c(1, 3))
par(mar=c(2, 1.25, 0.5, 0), oma = c(2.2, 3, 1.2, 0.5))
# no sig criteria
plot(x = x_seq, y = y_seq, type = "l", ylim = c(-0.5-0.5, 2.2-0.5), xlab = NA, ylab = NA, las = 1, cex = lnpt_cex)
#mtext(side = 1, "x", line = 2.5)
mtext(side = 2, "Derivative", line = 2.5)
mtext(side = 3, "Minima")
points(x_seq[pks11], y_seq[pks11], pch = 16)
points(x_seq[pks12], y_seq[pks12], pch = 16, col = pk_col, cex = pk_cex)

# sig criteria
ci_width1 <- 0.5
plot(x = x_seq, y = y_seq, type = "l", ylim = c(-0.5-0.5, 2.2-0.5), xlab = NA, ylab = NA, yaxt = "n", cex = lnpt_cex)
mtext(side = 1, "Driver", line = 2.5)
mtext(side = 3, "Significant minimum")
points(x_seq[pks12], y_seq[pks12], pch = 16, col = pk_col, cex = pk_cex)
polygon(x = c(x_seq, rev(x_seq)), y = c(y_seq-ci_width1, rev(y_seq + ci_width1)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
abline(h = max(y_seq-ci_width1), lty = 2)
#abline(h = min(y_seq+ci_width1), lty = 2)
text(x = 0.6, y = 1.35 - 0.5, "max(lower CI)")
arrows(x0 = x_seq[pks12][1], y0=(y_seq+ci_width1)[pks12][1], y1=max(y_seq-ci_width1), code = 3, length = 0.1)
#points(x = x_seq[which(y_seq-ci_width1==max(y_seq-ci_width1))])

ci_width1 <- 0.95
plot(x = x_seq, y = y_seq, type = "l", ylim = c(-0.5-0.5, 2.2-0.5), xlab = NA, ylab = NA, yaxt = "n", cex = lnpt_cex)
#mtext(side = 1, "x", line = 2.5)
mtext(side = 3, "Non-significant minimum")
points(x_seq[pks12], y_seq[pks12], pch = 16, col = pk_col, cex = pk_cex)
polygon(x = c(x_seq, rev(x_seq)), y = c(y_seq-ci_width1, rev(y_seq + ci_width1)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
abline(h = max(y_seq-ci_width1), lty = 2)
#abline(h = min(y_seq+ci_width1), lty = 2)
text(x = 0.6, y = 0.9 - 0.5, "max(lower CI)")
#arrows(x0 = x_seq[pks12][1], y0=(y_seq+ci_width1)[pks12][1], y1=max(y_seq-ci_width1), code = 3, length = 0.1)

dev.off()


# flipped for max
y_seq <- c(noise_set, c(0.1*(seq(from = -1.9, to = 5, by = 0.1)-2)^2)) - 0.5

pks11 <- c(findpeaks(y_seq)[,2], findpeaks(-y_seq)[,2])
pks12 <- c(findpeaks(y_seq, nups = 3)[,2], findpeaks(-y_seq, nups = 3)[,2])


pdf("figurepdfs/d_max.pdf", width = 8, height = 3)
par(mfrow = c(1, 3))
par(mar=c(2, 1.25, 0.5, 0), oma = c(2.2, 3, 1.2, 0.5))
plot(x = x_seq, y = -y_seq, type = "l", ylim = c(-2.2 +0.5, 0.5+0.5), xlab = NA, ylab = NA, las = 1, cex = lnpt_cex)
#mtext(side = 1, "x", line = 2.5)
mtext(side = 3, "Maxima")
mtext(side = 2, "Derivative", line = 2.5)
points(x_seq[pks11], -y_seq[pks11], pch = 16)
points(x_seq[pks12], -y_seq[pks12], pch = 16, col = pk_col, cex = pk_cex)

ci_width1 <- 0.5
plot(x = x_seq, y = -y_seq, type = "l", ylim = c(-2.2+0.5, 0.5+0.5), xlab = NA, ylab = NA, yaxt = "n", cex = lnpt_cex)
mtext(side = 1, "Driver", line = 2.5)
mtext(side = 3, "Significant maximum")
points(x_seq[pks12], -y_seq[pks12], pch = 16, col = pk_col, cex = pk_cex)
polygon(x = c(x_seq, rev(x_seq)), y = c(-y_seq-ci_width1, rev(-y_seq + ci_width1)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
abline(h = min(-y_seq+ci_width1), lty = 2)
#abline(h = min(y_seq+ci_width1), lty = 2)
text(x = 0.6, y = -1.35 + 0.5, "min(upper CI)")
arrows(x0 = x_seq[pks12][1], y0=(-y_seq-ci_width1)[pks12][1], y1=min(-y_seq+ci_width1), code = 3, length = 0.1)

ci_width1 <- 0.95
plot(x = x_seq, y = -y_seq, type = "l", ylim = c(-2.2+0.5, 0.5+0.5), xlab = NA, ylab = NA, yaxt = "n", cex = lnpt_cex)
#mtext(side = 1, "Driver", line = 2.5)
mtext(side = 3, "Non-significant maximum")
points(x_seq[pks12], -y_seq[pks12], pch = 16, col = pk_col, cex = pk_cex)
polygon(x = c(x_seq, rev(x_seq)), y = c(-y_seq-ci_width1, rev(-y_seq + ci_width1)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)
abline(h = min(-y_seq+ci_width1), lty = 2)
#abline(h = min(y_seq+ci_width1), lty = 2)
text(x = 0.6, y = -0.9 + 0.5, "min(upper CI)")
#arrows(x0 = x_seq[pks12][1], y0=(-y_seq-ci_width1)[pks12][1], y1=min(-y_seq+ci_width1), code = 3, length = 0.1)

dev.off()

```

roots (locations where the curve crosses the zero)

```{r}

x_seq2 <- c(seq(from = -0.42, to = -0.33, by = 0.03), seq(from = -0.3, to = 0.9, by = 0.03), seq(from = 0.93, to = 1.02, by = 0.03))

set.seed(105)
noise_set1 <- rnorm(length(seq(from = -0.42, to = -0.33, by = 0.03)), 0, 0.02)
noise_set2 <- rnorm(length(seq(from = 0.93, to = 1.02, by = 0.03)), 0, 0.02)

y_seq2 <- c(noise_set1, seq(from = -0.3, to = 0.9, by = 0.03)^3 - seq(from = -0.3, to = 0.9, by = 0.03)^2 + 0.1, noise_set2)

# get the approximate roots in y_seq2
root_index1 <- which(diff(sign(y_seq2))!=0)
roots1 <- (x_seq2[root_index1] + x_seq2[root_index1 + 1])/2

pdf("figurepdfs/d_root.pdf", width = 8, height = 3)
par(mfrow = c(1, 3))
par(mar=c(2, 1.25, 0.5, 0), oma = c(2.2, 3, 1.2, 0.5))
plot(x_seq2, y_seq2, type = "l", ylim = c(-0.08, 0.12), xlab = NA, ylab = NA, las = 1)
#mtext(side = 1, "x", line = 2.5)
mtext(side = 3, "Roots")
mtext(side = 2, "Derivative", line = 2.75)
abline(h = 0)
points(x = roots1, y = rep(0, length(roots1)), pch = 16)
points(x = roots1[4], y = 0, pch = 16, col = pk_col, cex = pk_cex)
abline(v = roots1, lty = 3)


# add sig criteria

ci_width3 <- 0.0275
root_index2 <- which(diff(sign(y_seq2-ci_width3))!=0)
roots2 <- (x_seq2[root_index2] + x_seq2[root_index2 + 1])/2

root_index3 <- which(diff(sign(y_seq2+ci_width3))!=0)
roots3 <- (x_seq2[root_index3] + x_seq2[root_index3 + 1])/2

plot(x_seq2, y_seq2, type = "l", ylim = c(-0.08, 0.12), xlab = NA, ylab = NA, yaxt = "n")
mtext(side = 1, "Driver", line = 2.5)
mtext(side = 3, "Significant root")
abline(h = 0)
points(x = roots1[4], y = 0, pch = 16, col = pk_col, cex = pk_cex)
points(x = x_seq2[root_index2+1][2], y = 0, pch = 1, col = pk_col, cex = 0.8*pk_cex)
points(x = x_seq2[root_index3][1], y = 0, pch = 1, col = pk_col, cex = 0.8*pk_cex)
polygon(x = c(x_seq2, rev(x_seq2)), y = c(y_seq2-ci_width3, rev(y_seq2 + ci_width3)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)

# example of non-significant root
ci_width3 <- 0.055
root_index2 <- which(diff(sign(y_seq2-ci_width3))!=0)

plot(x_seq2, y_seq2, type = "l", ylim = c(-0.08, 0.12), xlab = NA, ylab = NA, yaxt = "n")
abline(h = 0)
mtext(side = 3, "Non-significant root")
points(x = roots1[4], y = 0, pch = 16, col = pk_col, cex = pk_cex)
points(x = x_seq2[root_index2][2], y = 0, pch = 1, col = pk_col, cex = 0.8*pk_cex)
polygon(x = c(x_seq2, rev(x_seq2)), y = c(y_seq2-ci_width3, rev(y_seq2 + ci_width3)), col = adjustcolor("gray50", alpha.f = 0.3), border = NA)

dev.off()



```