metaTop_depth = depths[1]
Tdepth = rep(NaN, numDepths-1)
for(i in 1:(numDepths-1)){
Tdepth[i] = mean(depths[ i:(i+1) ]);
}
tmp = sort.int(unique(c(Tdepth, thermoD)), index.return = TRUE)
sortDepth = tmp$x
sortInd = tmp$ix
numDepths = length(sortDepth) #set numDepths again, it could have changed above
drho_dz = stats::approx(Tdepth, drho_dz, sortDepth)
drho_dz = drho_dz$y
#find the thermocline index
# this is where we will start our search for meta depths
thermo_index = which(sortDepth == thermoD)
for (i in thermo_index:numDepths){ # moving down from thermocline index
if (!is.na(drho_dz[i]) && drho_dz[i] < slope){ #top of metalimnion
metaBot_depth = sortDepth[i];
break
}
}
if (i-thermo_index >= 1 && (!is.na(drho_dz[thermo_index]) && drho_dz[thermo_index] > slope)){
metaBot_depth = stats::approx(drho_dz[thermo_index:i],
sortDepth[thermo_index:i],slope)
metaBot_depth = metaBot_depth$y
}
if(is.na(metaBot_depth)){
metaBot_depth = depths[numDepths]
}
for(i in seq(thermo_index,1)){
if(!is.na(drho_dz[i]) && drho_dz[i] < slope){
metaTop_depth = sortDepth[i];
break;
}
}
if(thermo_index - i >= 1 && (!is.na(drho_dz[thermo_index]) && drho_dz[thermo_index] > slope)){
metaTop_depth = stats::approx(drho_dz[i:thermo_index], sortDepth[i:thermo_index], slope);
metaTop_depth = metaTop_depth$y
}
if(is.na(metaTop_depth)){
metaTop_depth = depths[i]
}
return(c(metaTop_depth, metaBot_depth))
}
system.time(func(data = wtemp, depths = depths))
meta.depths = function(wtr, depths, slope=0.1, seasonal=TRUE, mixed.cutoff=1){
if(any(is.na(wtr))){
return(rep(NaN, 2))
}
#We can't determine anything with less than 3 measurements
# just return lake bottom
if(length(wtr) < 3){
return(c(max(depths), max(depths)))
}
depths = sort.int(depths, index.return=TRUE)
wtr = wtr[depths$ix]
depths = depths$x
index=FALSE
Smin = 0.1
if(any(is.na(wtr))){
thermoD = (NaN)
}
if(diff(range(wtr, na.rm=TRUE)) < mixed.cutoff){
thermoD = (NaN)
}
#We can't determine anything with less than 3 measurements
# just return lake bottom
if(length(wtr) < 3){
thermoD = (NaN)
}
if(length(depths) != length(unique(depths))){
stop('Depths all must be unique')
}
#We need water density, not temperature to do this
rhoVar = water.density(wtr)
dRhoPerc = 0.15; #in percentage max for unique thermocline step
numDepths = length(depths);
drho_dz = rep(NaN, numDepths-1);
#Calculate the first derivative of density
for(i in 1:(numDepths-1)){
drho_dz[i] = ( rhoVar[i+1]-rhoVar[i] )/( depths[i+1] - depths[i] );
}
#look for two distinct maximum slopes, lower one assumed to be seasonal
thermoInd = which.max(drho_dz)  #Find max slope
mDrhoZ = drho_dz[thermoInd]
thermoD = mean( depths[thermoInd:(thermoInd+1)] )
if(thermoInd > 1 && thermoInd < (numDepths-1)){  #if within range
Sdn = -(depths[thermoInd+1] - depths[thermoInd])/
(drho_dz[thermoInd+1] - drho_dz[thermoInd])
Sup = (depths[thermoInd]-depths[thermoInd-1])/
(drho_dz[thermoInd]-drho_dz[thermoInd-1])
upD  = depths[thermoInd];
dnD  = depths[thermoInd+1];
if( !is.infinite(Sup) & !is.infinite(Sdn) ){
thermoD = dnD*(Sdn/(Sdn+Sup))+upD*(Sup/(Sdn+Sup));
}
}
dRhoCut = max( c(dRhoPerc*mDrhoZ, Smin) )
# locs = findPeaks(drho_dz, dRhoCut)
dataIn = drho_dz
thresh = dRhoCut
# findPeaks <- function(dataIn, thresh=0){
varL = length(dataIn);
locs = rep(FALSE, varL);
peaks= rep(NaN, varL);
for(i in 2:varL-1){
pkI = which.max(dataIn[(i-1):(i+1)])
posPeak = max(dataIn[(i-1):(i+1)]);
if(pkI == 2) {
peaks[i] = posPeak;
locs[i]  = TRUE;
}
}
inds = 1:varL;
locs = inds[locs];
peaks= peaks[locs];
# remove all below threshold value
useI = peaks > thresh;
locs = locs[useI];
findPeaks = (locs)
####
pks = drho_dz[locs]
if(length(pks) == 0){
SthermoD = thermoD
SthermoInd = thermoInd
}else{
mDrhoZ = pks[length(pks)]
SthermoInd = locs[length(pks)]
if(SthermoInd > (thermoInd + 1)){
SthermoD = mean(depths[SthermoInd:(SthermoInd+1)])
if(SthermoInd > 1 && SthermoInd < (numDepths - 1)){
Sdn = -(depths[SthermoInd+1] - depths[SthermoInd])/
(drho_dz[SthermoInd+1] - drho_dz[SthermoInd])
Sup = (depths[SthermoInd] - depths[SthermoInd-1])/
(drho_dz[SthermoInd] - drho_dz[SthermoInd-1])
upD  = depths[SthermoInd]
dnD  = depths[SthermoInd+1]
if( !is.infinite(Sup) & !is.infinite(Sdn) ){
SthermoD = dnD*(Sdn/(Sdn+Sup))+upD*(Sup/(Sdn+Sup))
}
}
}else{
SthermoD = thermoD
SthermoInd = thermoInd
}
}
if(SthermoD < thermoD){
SthermoD = thermoD
SthermoInd = thermoInd
}
#Ok, which output was requested. Index or value
# seasonal or non-seasonal
if(index){
if(seasonal){
thermoD = SthermoInd
}else{
thermoD = (thermoInd)
}
}else{
if(seasonal){
thermoD = (SthermoD)
}else{
thermoD = (thermoD)
}
}
#list( thermoD, thermoInd, drho_dz, SthermoD, SthermoInd )
# Finds the local peaks in a vector. Checks the optionally supplied threshold
#  for minimum height.
##########
# if no thermo depth, then there can be no meta depths
if(is.na(thermoD)){
thermoD = (c(NaN, NaN))
}
#We need water density, not temperature to do this
sal = wtr*0
if(length(wtr) != length(sal)){
stop('water temperature array must be the same length as the salinity array')
}
# Determine which method we want to use, initially set both methods to false
MM = FALSE; # Martin & McCutcheon
UN = FALSE; # UNESCO
# specify temperature and salinity range for the calculations
Trng <- c(0,40) # temperature range
Srng <- c(0.5,43) # salinity range
# check to see if all values lie within the ranges specified
if ( all(sal < Srng[1], na.rm=TRUE) ){
MM <- TRUE # use Martin & McCutcheon
}else if (!(sum(wtr<Trng[1], na.rm=TRUE) || sum(wtr>Trng[2], na.rm=TRUE)) &&
!(sum(sal<Srng[1], na.rm=TRUE)) || sum(sal>Srng[2], na.rm=TRUE)){
UN <- TRUE # use UNESCO
}
# if MM is true we use method of Martin and McCutcheon (1999)
if (MM){
rho <- (1000*(1-(wtr+288.9414)*(wtr-3.9863)^2/(508929.2*(wtr+68.12963))))
}
# if UN is true we use method of Martin and McCutcheon (1999)
if (UN){
# -- equation 1:
rho_0 <- 999.842594 + 6.793952*10^(-2)*wtr - 9.095290*10^(-3)*wtr^2 + 1.001685*10^(-4)*wtr^3 - 1.120083*10^(-6)*wtr^4 + 6.536335e-9*wtr^5
# -- equation 2:
A <- 8.24493*10^(-1) - 4.0899e-3*wtr + 7.6438*10^(-5)*wtr^2 - 8.2467*10^(-7)*wtr^3 + 5.3875*10^(-9)*wtr^4
# -- equation 3:
B <- -5.72466*10^(-3) + 1.0227*10^(-4)*wtr - 1.6546*10^(-6)*wtr^2
# -- equation 4:
C <- 4.8314*10^(-4)
# -- equation 5:
rho <- rho_0 + A*sal + B*sal^(3/2) + C*sal^2
}
# if there is a combination of fresh and saline water we need to use a combination of MM and UN
if (MM == FALSE && UN == FALSE){
rho <- wtr*0
for (j in 1:length(rho)){
rho[j] <- water.density(wtr[j],sal[j])
}
dim(rho) <- dim(wtr) # ensure same dimension as input array
}
rhoVar = rho
dRhoPerc = 0.15; #in percentage max for unique thermocline step
numDepths = length(depths)
drho_dz = vector(mode="double", length=numDepths-1)
#Calculate the first derivative of density
for(i in 1:(numDepths-1)){
drho_dz[i] = ( rhoVar[i+1]-rhoVar[i] )/( depths[i+1] - depths[i] )
}
#initiate metalimnion bottom as last depth, this is returned if we can't
# find a bottom
metaBot_depth = depths[numDepths]
metaTop_depth = depths[1]
Tdepth = rep(NaN, numDepths-1)
for(i in 1:(numDepths-1)){
Tdepth[i] = mean(depths[ i:(i+1) ]);
}
tmp = sort.int(unique(c(Tdepth, thermoD)), index.return = TRUE)
sortDepth = tmp$x
sortInd = tmp$ix
numDepths = length(sortDepth) #set numDepths again, it could have changed above
drho_dz = stats::approx(Tdepth, drho_dz, sortDepth)
drho_dz = drho_dz$y
#find the thermocline index
# this is where we will start our search for meta depths
thermo_index = which(sortDepth == thermoD)
for (i in thermo_index:numDepths){ # moving down from thermocline index
if (!is.na(drho_dz[i]) && drho_dz[i] < slope){ #top of metalimnion
metaBot_depth = sortDepth[i];
break
}
}
if (i-thermo_index >= 1 && (!is.na(drho_dz[thermo_index]) && drho_dz[thermo_index] > slope)){
metaBot_depth = stats::approx(drho_dz[thermo_index:i],
sortDepth[thermo_index:i],slope)
metaBot_depth = metaBot_depth$y
}
if(is.na(metaBot_depth)){
metaBot_depth = depths[numDepths]
}
for(i in seq(thermo_index,1)){
if(!is.na(drho_dz[i]) && drho_dz[i] < slope){
metaTop_depth = sortDepth[i];
break;
}
}
if(thermo_index - i >= 1 && (!is.na(drho_dz[thermo_index]) && drho_dz[thermo_index] > slope)){
metaTop_depth = stats::approx(drho_dz[i:thermo_index], sortDepth[i:thermo_index], slope);
metaTop_depth = metaTop_depth$y
}
if(is.na(metaTop_depth)){
metaTop_depth = depths[i]
}
return(c(metaTop_depth, metaBot_depth))
}
system.time(func(data = wtemp, depths = depths))
require(compiler)
enableJIT(3)
slow_func_compiled <- cmpfun(func)
system.time(func(data = wtemp, depths = depths))
system.time(slow_func_compiled(data = wtemp, depths = depths))
comp_meta.depths <- cmpfun(meta.depths)
comp_meta.depths
comp_func <- function(data, depths){
res = apply(X = data, MARGIN = 1, FUN = function(x){
comp_meta.depths(x, depths = depths , slope = 0.1, seasonal = TRUE, mixed.cutoff = 1)
}
)
return(res)
}
system.time(comp_func(data = wtemp, depths = depths))
la1 <- function(X, FUN, ...) {
FUN <- match.fun(FUN)
if (!is.list(X))
X <- as.list(X)
rval <- vector("list", length(X))
for(i in seq(along = X))
rval[i] <- list(FUN(X[[i]], ...))
names(rval) <- names(X)		  # keep `names' !
return(rval)
}
# a small variation
la2 <- function(X, FUN, ...) {
FUN <- match.fun(FUN)
if (!is.list(X))
X <- as.list(X)
rval <- vector("list", length(X))
for(i in seq(along = X)) {
v <- FUN(X[[i]], ...)
if (is.null(v)) rval[i] <- list(v)
else rval[[i]] <- v
}
names(rval) <- names(X)		  # keep `names' !
return(rval)
}
# Compiled versions
la1c <- cmpfun(la1)
la2c <- cmpfun(la2)
# some timings
x <- 1:10
y <- 1:100
system.time(for (i in 1:10000) lapply(x, is.null))
system.time(for (i in 1:10000) la1(x, is.null))
system.time(for (i in 1:10000) la1c(x, is.null))
system.time(for (i in 1:10000) la2(x, is.null))
system.time(for (i in 1:10000) la2c(x, is.null))
system.time(for (i in 1:1000) lapply(y, is.null))
system.time(for (i in 1:1000) la1(y, is.null))
system.time(for (i in 1:1000) la1c(y, is.null))
system.time(for (i in 1:1000) la2(y, is.null))
system.time(for (i in 1:1000) la2c(y, is.null))
system.time(func(data = wtemp, depths = depths))
system.time(slow_func_compiled(data = wtemp, depths = depths))
system.time(comp_func(data = wtemp, depths = depths))
is.compile <- function(func){
if(class(func) != "function") stop("You need to enter a function")
last_2_lines <- tail(capture.output(func),2)
any(grepl("bytecode:", last_2_lines))
}
is.compile(func)
is.compile(slow_func_compiled)
is.compile(comp_func)
library(ggpubr)
?stat_compare_means
?compare_means
n.df = data.frame('tn' = c(281.47,277.33,138.58,199.36,181.58, 749.18,954.0,815.7), 'tp'= c(13.65,6.95,4.02,4.85,5.34,17.73,49.50,46.73))
n.df$tn/n.df$tp
n.df
n.df$ratio = n.df$tn/n.df$tp
ggplot(n.df, aes(tn, tp, col = ratio)) + geom_point()
library(ggplot2)
ggplot(n.df, aes(tn, tp, col = ratio)) + geom_point()
n.df$site = c(rep('north',5),rep('south',3))
str(n.df)
n.df$site = as.factor(n.df$site)
ggplot(n.df, aes(tn, tp, col = ratio, symbol = site)) + geom_point()
?ggplot
ggplot(n.df, aes(tn, tp, col = ratio, shape = site)) + geom_point()
ggplot(n.df, aes(log(tp), log(ratio), shape = site)) + geom_point()
n.df$name = c('al','bm','cr','sp','tr','fi','me','mo')
ggplot(n.df, aes(log(tp), log(ratio), shape = site)) + geom_point() + geom_text(name)
ggplot(n.df, aes(log(tp), log(ratio), shape = site,label = name)) + geom_point() + geom_label()
install.packages(c("ggplot2", "lubridate", "patchwork", "pracma", "reshape2", "rLakeAnalyzer", "rstudioapi", "tidyverse", "zoo"))
2.7 * 10^6
(30*100)/2.7 * 10^6
(30*100)/(2.7 * 10^6)
(30*100)/(2.7 * 10^6) * 1000
install.packages(rEDM)
install.packages("rEDM")
data(sardine_anchovy_sst)
df <- CCM( dataFrame=sardine_anchovy_sst, E=3, Tp=0, columns="anchovy", target="np_sst", libSizes="10 70 10", sample=100 )
library(rEDM)
data(sardine_anchovy_sst)
df <- CCM( dataFrame=sardine_anchovy_sst, E=3, Tp=0, columns="anchovy", target="np_sst", libSizes="10 70 10", sample=100 )
df
data(sardine_anchovy_sst)
df <- CCM( dataFrame=sardine_anchovy_sst, E=3, Tp=0, columns="anchovy", target="np_sst", libSizes="10 70 10", sample=100 , showPlot = T)
head(df)
df
sardine_anchovy_sst
library(NTLlakeloads)
library(tidyverse)
library(lubridate)
library(ggplot2)
devtools::install_github('hudgan/NTLlakeloads')
devtools::install_github('hdugan/NTLlakeloads')
devtools::install_github('hdugan/NTLlakeloads')
devtools::install_github('hdugan/NTLlakeloads')
library(NTLlakeloads)
library(tidyverse)
library(lubridate)
library(ggplot2)
temp = loadLTERtemp()
nut = loadLTERnutrients() %>%
mutate(TN.sloh = if_else(!is.na(kjdl_n_sloh), kjdl_n_sloh + no3no2_sloh, totnuf_sloh)) %>%
mutate(TN = dplyr::coalesce(totnuf, TN.sloh*1000)) %>%
mutate(TP = dplyr::coalesce(totpuf, totpuf_sloh*1000))
chl = loadLTERchlorophyll.south()
wtemp = temp %>%
left_join(lakestats, by = c('lakeid' = 'LakeAbr')) %>%
filter(lakeid %in% c(ME)) %>%
group_by(sampledate) %>%
summarise(mean.wtr = mean(wtemp, na.rm = T),
mean.do = mean(o2, na.rm = T))
TP = nut %>%
left_join(lakestats, by = c('lakeid' = 'LakeAbr')) %>%
filter(lakeid %in% c('ME')) %>%
filter(!flagtotpuf %in% c('H','A','K') | is.na(flagtotpuf)) %>%
filter(TP >= 0) %>%
group_by(sampledate) %>%
summarise(mean.var = mean(TP, na.rm = T))
Chlorophyll_south= chla_south %>%
left_join(lakestats, by = c('lakeid' = 'LakeAbr')) %>%
filter(lakeid %in% c('ME')) %>%
group_by(sampledate) %>%
summarise(mean.var = mean(correct_chl_fluor, na.rm = T))
wtemp = temp %>%
filter(lakeid %in% c(ME)) %>%
group_by(sampledate) %>%
summarise(mean.wtr = mean(wtemp, na.rm = T),
mean.do = mean(o2, na.rm = T))
temp
wtemp = temp %>%
# left_join(lakestats, by = c('lakeid' = 'LakeAbr')) %>%
filter(lakeid %in% c(ME)) %>%
group_by(sampledate) %>%
summarise(mean.wtr = mean(wtemp, na.rm = T),
mean.do = mean(o2, na.rm = T))
temp
unique(temp$lakeid)
wtemp = temp %>%
# left_join(lakestats, by = c('lakeid' = 'LakeAbr')) %>%
filter(lakeid == c(ME)) %>%
group_by(sampledate) %>%
summarise(mean.wtr = mean(wtemp, na.rm = T),
mean.do = mean(o2, na.rm = T))
wtemp = temp %>%
# left_join(lakestats, by = c('lakeid' = 'LakeAbr')) %>%
filter(lakeid == 'ME') %>%
group_by(sampledate) %>%
summarise(mean.wtr = mean(wtemp, na.rm = T),
mean.do = mean(o2, na.rm = T))
wtemp
TP = nut %>%
filter(lakeid == 'ME') %>%
filter(!flagtotpuf %in% c('H','A','K') | is.na(flagtotpuf)) %>%
filter(TP >= 0) %>%
group_by(sampledate) %>%
summarise(mean.var = mean(TP, na.rm = T))
Chlorophyll= chl %>%
filter(lakeid == 'ME') %>%
group_by(sampledate) %>%
summarise(mean.var = mean(correct_chl_fluor, na.rm = T))
ggplot(wtemp) +
geom_line(aes(datetime, mean.wtr, col = 'WTR'))
ggplot(wtemp) +
geom_line(aes(sampledate, mean.wtr, col = 'WTR'))
ggplot(wtemp) +
geom_line(aes(sampledate, mean.wtr, col = 'WTR')) +
theme_minimal() +
ggtitle("wtemp avg.")
ggplot(wtemp) +
geom_line(aes(sampledate, mean.do)) +
theme_minimal() +
ggtitle("DO avg.")
ggplot(wtemp) +
geom_line(aes(sampledate, mean.wtr)) +
theme_minimal() +
ggtitle("wtemp avg.")
ggplot(wtemp) +
geom_line(aes(sampledate, mean.do)) +
theme_minimal() +
ggtitle("DO avg.")
library(patchwork)
ggplot(TP) +
geom_line(aes(mean.var)) +
theme_minimal() +
ggtitle("TP avg.")
ggplot(TP) +
geom_line(aes(sampledate, mean.var)) +
theme_minimal() +
ggtitle("TP avg.")
ggplot(Chlorophyll) +
geom_line(aes(sampledate, mean.var)) +
theme_minimal() +
ggtitle("Chl-a avg.")
g1 / g2 / g3 / g4
g1 <- ggplot(wtemp) +
geom_line(aes(sampledate, mean.wtr)) +
theme_minimal() +
ggtitle("wtemp avg.")
g2 <- ggplot(wtemp) +
geom_line(aes(sampledate, mean.do)) +
theme_minimal() +
ggtitle("DO avg.")
g3 <- ggplot(TP) +
geom_line(aes(sampledate, mean.var)) +
theme_minimal() +
ggtitle("TP avg.")
g4 <- ggplot(Chlorophyll) +
geom_line(aes(sampledate, mean.var)) +
theme_minimal() +
ggtitle("Chl-a avg.")
g1 / g2 / g3 / g4
setwd('Documents/CoPaper/Dugan2021/example/mendota/GLM/')
library(glmtools)
run_glm(sim_folder = '.', nml_file = 'glm3.nml')
plot_var(nc_file = 'output/output.nc', var_name = 'temp', reference = 'surface')
run_glm(sim_folder = '.', nml_file = 'glm3.nml')
plot_var(nc_file = 'output/output.nc', var_name = 'temp', reference = 'surface')
run_glm(sim_folder = '.', nml_file = 'glm3.nml')
plot_var(nc_file = 'output/output.nc', var_name = 'temp', reference = 'surface')
run_glm(sim_folder = '.', nml_file = 'glm3.nml')
plot_var(nc_file = 'output/output.nc', var_name = 'temp', reference = 'surface')
run_glm(sim_folder = '.', nml_file = 'glm3.nml')
plot_var(nc_file = 'output/output.nc', var_name = 'temp', reference = 'surface')
run_glm(sim_folder = '.', nml_file = 'glm3.nml')
plot_var(nc_file = 'output/output.nc', var_name = 'temp', reference = 'surface')
