## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set( global.par = TRUE ) knitr::opts_chunk$set( collapse = TRUE, comment = "#>", cache = FALSE, fig.retina = 2 ) #knitr::opts_chunk$set(optipng = "-o7 -strip all") #knitr::knit_hooks$set(optipng = knitr::hook_optipng) old_options_peak2d_scripts <- options(digits = 5, width = 90) old_options_mc_cores <- NULL check_limit_cores <- tolower(Sys.getenv("_R_CHECK_LIMIT_CORES_", "")) if (nzchar(check_limit_cores) && (check_limit_cores != "false")) { old_options_mc_cores <- options(mc.cores = 2) } # Set to FALSE to run the vignette in the current working directory. run_in_temp <- TRUE if (Sys.getenv("IN_PKGDOWN") == "" && ! interactive()) { knitr::opts_chunk$set(fig.retina = 1) } else { run_in_temp <- FALSE } original_wd <- getwd() if (run_in_temp) { vignette_wd <- file.path(tempdir(), "fitnmr_peak2d_scripts") dir.create(vignette_wd, showWarnings=FALSE, recursive=TRUE) knitr::opts_knit$set(root.dir = vignette_wd) } else { vignette_wd <- original_wd # Clean up old results unlink(c("fit", "refine", "extend"), recursive = TRUE, force = TRUE) } ## ----results = if (Sys.getenv("IN_PKGDOWN")=="" && !interactive()) "asis" else "hide", echo = FALSE---- cat("**Note:** A high-resolution version of this document is [available online](https://smith-group.github.io/fitnmr/articles/peak2d_scripts.html).") ## ----results = "hide"------------------------------------------------------------------- system.file("demo", package="fitnmr") ## ----include = FALSE-------------------------------------------------------------------- pdf <- function(file, width=7, height=7, pointsize=12) { if (file == "fit_iterations.pdf") { file <- "fit_iterations_%02i.pdf" width <- 3.4 height <- 3.4 pointsize <- 10 } file <- sub(".pdf$", ".png", file) width <- min(width, 7) height <- min(height, 7) if (Sys.getenv("IN_PKGDOWN") == "" && ! interactive()) { grDevices::png(file, width, height, "in", pointsize, res=96) } else { grDevices::png(file, width, height, "in", pointsize, res=192) } } update_cex <- function(file, cex) { script_lines <- readLines(file) script_lines <- sub("^cex <- 0.2", paste("cex <-", cex), script_lines) writeLines(script_lines, file) } ## ----results = "hide"------------------------------------------------------------------- dir.create("fit") ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = file.path(vignette_wd, "fit")) ## --------------------------------------------------------------------------------------- basename(getwd()) ## ----echo = FALSE----------------------------------------------------------------------- t1_dir <- system.file("extdata", "t1", package="fitnmr") t1_ft2_filenames <- list.files(t1_dir, pattern=".ft2") ## ----results = "hide"------------------------------------------------------------------- file.copy(file.path(t1_dir, t1_ft2_filenames[1]), ".") ## ----results = "hide"------------------------------------------------------------------- file.copy(system.file("demo", "fit_peaks_2d.R", package="fitnmr"), ".") ## ----include = FALSE-------------------------------------------------------------------- update_cex("fit_peaks_2d.R", 0.6) ## ----echo = FALSE, comment = NA--------------------------------------------------------- fit_peaks_2d_lines <- readLines("fit_peaks_2d.R") library_idx <- grep("^library", fit_peaks_2d_lines) cat(fit_peaks_2d_lines[seq(1, library_idx-3)], sep="\n") ## --------------------------------------------------------------------------------------- source("fit_peaks_2d.R") ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = vignette_wd) ## ----include = FALSE-------------------------------------------------------------------- list.files("fit") ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("fit", "noise_histograms.png")) ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("fit", sprintf("fit_iterations_%02i.png", 1:4))) ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("fit", "fit_spectra.png")) ## ----echo = FALSE, results = "asis"----------------------------------------------------- csv_table <- read.csv(file.path("fit", "fit_volume.csv"), check.names = FALSE) csv_table[,"f_pvalue"] <- sprintf("%0.2e", csv_table[,"f_pvalue"]) knitr::kable(csv_table) ## ----results = "hide"------------------------------------------------------------------- dir.create("refine") ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = file.path(vignette_wd, "refine")) ## --------------------------------------------------------------------------------------- basename(getwd()) ## ----results = "hide"------------------------------------------------------------------- file.copy(file.path(t1_dir, t1_ft2_filenames[1]), ".") file.copy(system.file("demo", "refit_peaks_2d.R", package="fitnmr"), ".") ## ----include = FALSE-------------------------------------------------------------------- update_cex("refit_peaks_2d.R", 0.6) ## ----echo = FALSE, comment = NA--------------------------------------------------------- refit_peaks_2d_lines <- readLines("refit_peaks_2d.R") library_idx <- grep("^library", refit_peaks_2d_lines) cat(refit_peaks_2d_lines[seq(1, library_idx-3)], sep="\n") ## ----results = "hide"------------------------------------------------------------------- file.copy(file.path("..", "fit", "fit_volume.csv"), "start_volume.csv") ## ----results = "hide"------------------------------------------------------------------- input_table <- read.csv("start_volume.csv", check.names=FALSE) input_table[c(5,7),"fit"] <- max(input_table[,"fit"])+1 input_table <- input_table[-c(4,14,16),] write.csv(input_table, "start_volume.csv", row.names=FALSE) ## --------------------------------------------------------------------------------------- source("refit_peaks_2d.R") ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = vignette_wd) ## ----include = FALSE-------------------------------------------------------------------- list.files("refine") ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("refine", "1_fit.png")) ## ----echo = FALSE, results = "asis"----------------------------------------------------- csv_table <- read.csv(file.path("refine", "1_volume.csv"), check.names = FALSE) knitr::kable(csv_table) ## ----results = "hide"------------------------------------------------------------------- dir.create("extend", FALSE) ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = file.path(vignette_wd, "extend")) ## --------------------------------------------------------------------------------------- basename(getwd()) ## ----results = "hide"------------------------------------------------------------------- file.copy(file.path(t1_dir, t1_ft2_filenames), ".") file.copy(file.path("..", "refine", "1_volume.csv"), "start_volume.csv") ## ----results = "hide"------------------------------------------------------------------- file.copy(system.file("demo", "refit_peaks_2d.R", package="fitnmr"), ".") ## ----include = FALSE-------------------------------------------------------------------- update_cex("refit_peaks_2d.R", 0.6) script_lines <- readLines("refit_peaks_2d.R") script_lines <- sub("mc_cores <- parallel::detectCores\\(\\)", "mc_cores <- 1", script_lines) writeLines(script_lines, "refit_peaks_2d.R") ## --------------------------------------------------------------------------------------- script_lines <- readLines("refit_peaks_2d.R") script_lines <- sub("fit_sc <- TRUE", "fit_sc <- FALSE", script_lines) script_lines <- sub("fit_r2 <- TRUE", "fit_r2 <- FALSE", script_lines) writeLines(script_lines, "refit_peaks_2d.R") ## ----echo = FALSE, comment = NA--------------------------------------------------------- extend_peaks_2d_lines <- readLines("refit_peaks_2d.R") fit_omega0_idx <- grep("^fit_omega0", extend_peaks_2d_lines) cat(extend_peaks_2d_lines[seq(fit_omega0_idx-1, fit_omega0_idx+7)], sep="\n") ## --------------------------------------------------------------------------------------- source("refit_peaks_2d.R") ## ----include = FALSE-------------------------------------------------------------------- list.files() ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = vignette_wd) ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("extend", "2_fit.png")) ## ----echo = FALSE, results = "asis"----------------------------------------------------- csv_table <- read.csv(file.path("extend", "2_volume.csv"), check.names = FALSE) knitr::kable(csv_table) ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = file.path(vignette_wd, "extend")) ## ----results = "hide"------------------------------------------------------------------- file.copy(system.file("extdata", "t1", "assignments.csv", package="fitnmr"), ".") ## ----echo = FALSE, results = "asis"----------------------------------------------------- csv_table <- read.csv("assignments.csv", check.names = FALSE) knitr::kable(csv_table) ## ----results = "hide"------------------------------------------------------------------- file.copy(system.file("demo", "assign_peaks_2d.R", package="fitnmr"), ".") ## ----echo = FALSE, comment = NA--------------------------------------------------------- assign_peaks_2d_lines <- readLines("assign_peaks_2d.R") library_idx <- grep("^library", assign_peaks_2d_lines) cat(assign_peaks_2d_lines[seq(1, library_idx-3)], sep="\n") ## ----include = FALSE-------------------------------------------------------------------- update_cex("assign_peaks_2d.R", 0.6) ## --------------------------------------------------------------------------------------- script_lines <- readLines("assign_peaks_2d.R") script_lines <- sub("thresh_1 <- 0.1", "thresh_1 <- 0.2", script_lines) script_lines <- sub("cs_adj_2 <- c\\(0, 0\\)", "cs_adj_2 <- c(-0.02, 0)", script_lines) script_lines <- sub("thresh_2 <- 0.025", "thresh_2 <- 0.075", script_lines) writeLines(script_lines, "assign_peaks_2d.R") ## ----echo = FALSE, comment = NA--------------------------------------------------------- extend_peaks_2d_lines <- readLines("refit_peaks_2d.R") thresh_1_idx <- grep("^thresh_1", script_lines) cat(script_lines[seq(thresh_1_idx-1, thresh_1_idx+6)], sep="\n") ## --------------------------------------------------------------------------------------- source("assign_peaks_2d.R") ## ----include = FALSE-------------------------------------------------------------------- list.files() ## ----include = FALSE-------------------------------------------------------------------- knitr::opts_knit$set(root.dir = vignette_wd) ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("extend", "assign_stages.png")) ## ----echo = FALSE, hold = TRUE---------------------------------------------------------- knitr::include_graphics(file.path("extend", "assign_omegas.png")) ## ----echo = FALSE, results = "asis"----------------------------------------------------- csv_table <- read.csv(file.path("extend", "assign_volume.csv"), check.names = FALSE) csv_table[,"assignment"] <- as.character(csv_table[,"assignment"]) csv_table[is.na(csv_table[,"assignment"]),"assignment"] <- "" knitr::kable(csv_table) ## ----include = FALSE---------------------------------------------------------- knitr::opts_knit$set(root.dir = original_wd) if (!is.null(old_options_mc_cores)) { options(old_options_mc_cores) } options(old_options_peak2d_scripts)