#' Fine-tune an already fitted sync_model
#' Wrapper function to re-run getSyncModel() using the same data, but excluding outliers. Note dimensions of data might change if eps_threshold results in empty rows in the TOA-matrix.
#' @param sync_model sync_model obtained using getSyncModel()
#' @param eps_threshold Maximum value of residual measured in meter assuming speed of sound = 1450 m/s
#' @param silent logical whether to make getSyncModel() silent
#' @export
#' @return Fine tuned `sync_model`. See `?getSyncModel` for more info.
#' @example man/examples/example-yaps_ssu1.R
fineTuneSyncModel <- function(sync_model, eps_threshold, silent=TRUE){
# original inp_sync
inp_sync <- sync_model$inp_synced
# getting resids, identify outliers and get rid of them everywhere in inp_sync
resids <- sync_model$report$eps
resids[resids == 0] <- NA
outliers <- which(abs(resids)*1450 > eps_threshold)
inp_sync$dat_tmb_sync$toa_offset[outliers] <- NA
inp_sync$inp_params$toa[outliers] <- NA
# check if any empty rows now exists - if so get rid of them entirely
nobs <- apply(inp_sync$dat_tmb_sync$toa_offset, 1, function(k) sum(!is.na(k)))
empty_rows <- which(nobs < inp_sync$inp_params$min_hydros)
if(length(empty_rows) > 0){
inp_sync$dat_tmb_sync$toa_offset <- inp_sync$dat_tmb_sync$toa_offset[-empty_rows, ]
inp_sync$dat_tmb_sync$sync_tag_idx_vec <- inp_sync$dat_tmb_sync$sync_tag_idx_vec[-empty_rows]
inp_sync$dat_tmb_sync$offset_idx <- inp_sync$dat_tmb_sync$offset_idx[-empty_rows]
inp_sync$dat_tmb_sync$ss_idx <- inp_sync$dat_tmb_sync$ss_idx[-empty_rows]
inp_sync$dat_tmb_sync$np <- inp_sync$dat_tmb_sync$np - length(empty_rows)
if(inp_sync$dat_tmb_sync$ss_data_what == "data"){
inp_sync$dat_tmb_sync$ss_data_vec = inp_sync$dat_tmb_sync$ss_data_vec [-empty_rows]
}
inp_sync$params_tmb_sync$TOP <- inp_sync$params_tmb_sync$TOP[-empty_rows]
inp_sync$inp_params$toa <- inp_sync$inp_params$toa[-empty_rows, ]
}
# # # attempt to speed up next getSyncModel() by setting initial param values to relevant values
# # # If NAs in OFFSET or SLOPEs it will not work...
# inp_sync$params_tmb_sync$OFFSET <- sync_model$pl$OFFSET
# inp_sync$params_tmb_sync$SLOPE1 <- sync_model$pl$SLOPE1
# inp_sync$params_tmb_sync$SLOPE2 <- sync_model$pl$SLOPE2
# inp_sync$params_tmb_sync$SS <- sync_model$pl$SS # Disabled because option to use ss_data is implemented...
# inp_sync$params_tmb_sync$LOG_SIGMA_HYDROS_XY <- sync_model$pl$LOG_SIGMA_HYDROS_XY
# inp_sync$params_tmb_sync$TRUE_H <- sync_model$pl$TRUE_H
# inp_sync$params_tmb_sync$LOG_SIGMA_TOA <- sync_model$pl$LOG_SIGMA_TOA
# run getSyncModel() using the tuned inp_sync
sync_model_tuned <- getSyncModel(inp_sync, silent=silent, tmb_smartsearch=inp_sync$inp_params$tmb_smartsearch, max_iter=inp_sync$inp_params$max_iter)
return(sync_model_tuned)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.