From b437d960e6e7f97e9620267b342f6e6b769885db Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 22:40:42 +0100 Subject: [PATCH 01/10] =?UTF-8?q?=F0=9F=9A=87Update=20R=20GitHub=20actions?= =?UTF-8?q?=20workflow?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bring it in sync with the TIMP workflow --- .github/workflows/r.yml | 61 ++++++++++------------------------------- 1 file changed, 15 insertions(+), 46 deletions(-) diff --git a/.github/workflows/r.yml b/.github/workflows/r.yml index eb2fa5c..408f310 100644 --- a/.github/workflows/r.yml +++ b/.github/workflows/r.yml @@ -10,6 +10,8 @@ # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions on: + schedule: + - cron: '30 20 1 1-12 *' push: branches: - main @@ -33,8 +35,8 @@ jobs: config: - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true @@ -42,54 +44,21 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true - - uses: r-lib/actions/setup-pandoc@v1 - - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Cache R packages - if: runner.os != 'Windows' - uses: actions/cache@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install system dependencies - if: runner.os == 'Linux' - run: | - while read -r cmd - do - eval sudo $cmd - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - - - name: Install dependencies - run: | - remotes::install_deps(dependencies = TRUE) - remotes::install_cran("rcmdcheck") - shell: Rscript {0} - - - name: Check - env: - _R_CHECK_CRAN_INCOMING_REMOTE_: false - run: | - options(crayon.enabled = TRUE) - rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") - shell: Rscript {0} + extra-packages: any::rcmdcheck + needs: check - - name: Upload check results - if: failure() - uses: actions/upload-artifact@main + - uses: r-lib/actions/check-r-package@v2 with: - name: ${{ runner.os }}-r${{ matrix.config.r }}-results - path: check + upload-snapshots: true From 7734a10ff736d725d80caaccad9a77549309bd7a Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:25:32 +0100 Subject: [PATCH 02/10] =?UTF-8?q?=F0=9F=9A=87Add=20R=20linter=20action?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .Rbuildignore | 8 ++++++-- .github/workflows/lint.yaml | 33 +++++++++++++++++++++++++++++++++ .lintr | 20 ++++++++++++++++++++ 3 files changed, 59 insertions(+), 2 deletions(-) create mode 100644 .github/workflows/lint.yaml create mode 100644 .lintr diff --git a/.Rbuildignore b/.Rbuildignore index a5813ce..9dfab96 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,8 +1,12 @@ ^.*\.Rproj$ ^\.Rproj\.user$ -.git -.gitignore +^\.git +^\.gitignore +^\.vscode ^\.github$ +^\.builds +^\.lintr$ +^\.pytest_cache LICENSE.md README.md CONTRIBUTING.md diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 0000000..fa30afe --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,33 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main] + pull_request: + branches: [main] + +name: lint + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::lintr, local::. + needs: lint + + - name: Lint + run: lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: false + LINTR_COMMENT_BOT: false diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..1f5e0ce --- /dev/null +++ b/.lintr @@ -0,0 +1,20 @@ +linters: linters_with_defaults( + line_length_linter(120), + # Nice to haves + commented_code_linter = NULL, + object_name_linter=NULL, + single_quotes_linter = NULL, + commas_linter = NULL, + infix_spaces_linter = NULL, + cyclocomp_linter = NULL, + # Should haves + seq_linter = NULL, + object_usage_linter = NULL, + vector_logic_linter = NULL + ) +exclusions: list( + "inst", + "man", + "tests" + ) +encoding: "UTF-8" From 6994e11d6da48b2733aa1fa45e98769b8a1b1812 Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:25:51 +0100 Subject: [PATCH 03/10] Add spelling WORDLIST for spell_check --- inst/WORDLIST | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 inst/WORDLIST diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..9205bc4 --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,21 @@ +IRF +Khatri +Rao +Spectrotemporal +Stokkum +TIMP +et +al +bzip +gzip +kronecker +kroneckercol +lin +linlog +nm +peridinin +positivity +rdata +runGUI +spectemp +xz From 59ac253ef9ee1c9f1bbdab4ef751e092175249da Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:28:25 +0100 Subject: [PATCH 04/10] Update doi link --- DESCRIPTION | 3 ++- R/example_dataset.R | 8 ++++---- R/paramGUI-package.R | 1 - man/example_dataset.Rd | 6 +++--- man/paramGUI.Rd | 3 --- 5 files changed, 9 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f3dd4f0..c2087cb 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,4 +19,5 @@ Depends: License: GPL (>= 2) Encoding: UTF-8 LazyData: true -RoxygenNote: 7.0.2 +RoxygenNote: 7.2.3 +Language: en-US diff --git a/R/example_dataset.R b/R/example_dataset.R index 8723df5..594662e 100644 --- a/R/example_dataset.R +++ b/R/example_dataset.R @@ -1,12 +1,12 @@ -#' This is data to be included in my package +#' This is an example dataset included in this package #' #' @name example_dataset #' @aliases datamat times waves #' @docType data #' @author Ivo van Stokkum \email{i.h.m.van.stokkum@vu.nl} -#' @references \url{https://dx.doi.org/10.1016/j.chemphys.2008.10.005} +#' @references \doi{10.1016/j.chemphys.2008.10.005} #' @keywords data -#' @description Dispersion corrected time-resolved transient-absoprtion data -#' of the peridinin chlorophyll protein (PCP) excited with 490 nm laser light +#' @description Dispersion corrected time-resolved transient-absoprtion data +#' of the peridinin chlorophyll protein (PCP) excited with 490 nm laser light #' from the publication of Stokkum et.al. (2009) NULL diff --git a/R/paramGUI-package.R b/R/paramGUI-package.R index 6dbf311..af0a4a6 100644 --- a/R/paramGUI-package.R +++ b/R/paramGUI-package.R @@ -5,4 +5,3 @@ #' @import shiny shinydashboard #' @importFrom TIMP initModel fitModel NULL - diff --git a/man/example_dataset.Rd b/man/example_dataset.Rd index 3117a6e..f606b69 100644 --- a/man/example_dataset.Rd +++ b/man/example_dataset.Rd @@ -8,12 +8,12 @@ \alias{waves} \title{This is data to be included in my package} \description{ -Dispersion corrected time-resolved transient-absoprtion data -of the peridinin chlorophyll protein (PCP) excited with 490 nm laser light +Dispersion corrected time-resolved transient-absoprtion data +of the peridinin chlorophyll protein (PCP) excited with 490 nm laser light from the publication of Stokkum et.al. (2009) } \references{ -\url{https://dx.doi.org/10.1016/j.chemphys.2008.10.005} +\doi{10.1016/j.chemphys.2008.10.005} } \author{ Ivo van Stokkum \email{i.h.m.van.stokkum@vu.nl} diff --git a/man/paramGUI.Rd b/man/paramGUI.Rd index 15f635b..e6bfa61 100755 --- a/man/paramGUI.Rd +++ b/man/paramGUI.Rd @@ -4,6 +4,3 @@ \name{paramGUI} \alias{paramGUI} \title{paramGUI} -\description{ -paramGUI -} From 16935f07367fdcbed71c7025490d9558fbfd486e Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:28:35 +0100 Subject: [PATCH 05/10] Reformat files according to styler --- R/paramGUI.R | 457 ++++++++++++------- R/runApp.R | 1 - R/utility.R | 32 +- inst/shinyApps/paramGUI/app.R | 803 ++++++++++++++++++---------------- 4 files changed, 750 insertions(+), 543 deletions(-) diff --git a/R/paramGUI.R b/R/paramGUI.R index 4e41193..cfb43b2 100755 --- a/R/paramGUI.R +++ b/R/paramGUI.R @@ -11,7 +11,7 @@ #' @export #' calcE <- function(theta, lambda) { - nspec <- length(theta)/3 + nspec <- length(theta) / 3 nl <- length(lambda) npare <- 3 spec <- matrix(nrow = nl, ncol = nspec) @@ -32,7 +32,8 @@ calcE <- function(theta, lambda) { #' \code{TRUE} if the \code{kroneckcol} function should be used to formulate the model and #' \code{FALSE} if the standard \code{kronecker} is to be used instead #' @param lin defines the range to plot linearly (from -\code{lin} to +\code{lin}) -#' @param l_posk object of class \code{logical} indicating whether positivity constraints are enforced on the rate parameters +#' @param l_posk object of class \code{logical} indicating whether +#' positivity constraints are enforced on the rate parameters #' #' @importFrom TIMP compModel #' @importFrom stats nls nls.control @@ -40,7 +41,7 @@ calcE <- function(theta, lambda) { #' @export #' spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, - l_posk = FALSE) { + l_posk = FALSE) { psisim <- as.vector(sim@psi.df) dummy <- as.data.frame(psisim) @@ -56,38 +57,60 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, ## list of specpar, as opposed to a vector if (l_posk) { if (kroncol) { - kronform <- psisim ~ kroneckercol(A = calcE(sp, x2), - B = compModel(k = exp(k), x = x, seqmod = seqmod, - irf = irf, irfpar = irfpar)) + kronform <- psisim ~ kroneckercol( + A = calcE(sp, x2), + B = compModel( + k = exp(k), x = x, seqmod = seqmod, + irf = irf, irfpar = irfpar + ) + ) } else { - kronform <- psisim ~ kronecker(calcE(sp, x2), compModel(k = exp(k), - x = x, seqmod = seqmod, irf = irf, irfpar = irfpar)) + kronform <- psisim ~ kronecker(calcE(sp, x2), compModel( + k = exp(k), + x = x, seqmod = seqmod, irf = irf, irfpar = irfpar + )) } # NB warnOnly=TRUE, to return also in case of nonconvergence - onls <- nls(kronform, control = nls.control(printEval = TRUE, - warnOnly = TRUE, maxiter = iter), start = list(k = log(kinpar), - sp = specpar, irfpar = irfpar), algorithm = "plinear", - trace = TRUE) - + onls <- nls(kronform, + control = nls.control( + printEval = TRUE, + warnOnly = TRUE, maxiter = iter + ), start = list( + k = log(kinpar), + sp = specpar, irfpar = irfpar + ), algorithm = "plinear", + trace = TRUE + ) } else { # not lposk if (kroncol) { - kronform <- psisim ~ kroneckercol(A = calcE(sp, x2), - B = compModel(k = k, x = x, seqmod = seqmod, - irf = irf, irfpar = irfpar)) + kronform <- psisim ~ kroneckercol( + A = calcE(sp, x2), + B = compModel( + k = k, x = x, seqmod = seqmod, + irf = irf, irfpar = irfpar + ) + ) } else { - kronform <- psisim ~ kronecker(calcE(sp, x2), compModel(k = k, - x = x, seqmod = seqmod, irf = irf, irfpar = irfpar)) + kronform <- psisim ~ kronecker(calcE(sp, x2), compModel( + k = k, + x = x, seqmod = seqmod, irf = irf, irfpar = irfpar + )) } # NB warnOnly=TRUE, to return also in case of nonconvergence - onls <- nls(kronform, control = nls.control(printEval = TRUE, - warnOnly = TRUE, maxiter = iter), start = list(k = kinpar, - sp = specpar, irfpar = irfpar), algorithm = "plinear", - trace = TRUE) - - } #unexpected closing bracket + onls <- nls(kronform, + control = nls.control( + printEval = TRUE, + warnOnly = TRUE, maxiter = iter + ), start = list( + k = kinpar, + sp = specpar, irfpar = irfpar + ), algorithm = "plinear", + trace = TRUE + ) + } # unexpected closing bracket # sumonlskron <- summary(onls, correlation=TRUE) if(kroncol) # { assign('sumonlssingle', sumonlskron, envir=.GlobalEnv) } @@ -115,7 +138,6 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, # plotterforGUI(modtype='spectemp', data=sim, model=model, # theta=theta, result=onls, lin = lin) list(theta = theta, onls = onls) - } @@ -158,7 +180,7 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, while (cntmin > minorigx) { cntmin <- cntmin * 10 ticsl <- append(ticsl, cntmin) - tics <- append(tics, -alpha - (alpha * log10(-cntmin/alpha))) + tics <- append(tics, -alpha - (alpha * log10(-cntmin / alpha))) } ticsl <- append(sort(ticsl), c(0, alpha)) tics <- append(sort(tics), c(0, alpha)) @@ -166,7 +188,7 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, while (cntmax < maxorigx) { cntmax <- cntmax * 10 ticsl <- append(ticsl, cntmax) - tics <- append(tics, alpha + (alpha * log10(cntmax/alpha))) + tics <- append(tics, alpha + (alpha * log10(cntmax / alpha))) } ## new x values as column 1 new x labels as colum 2 ret <- cbind(tics, ticsl) @@ -196,9 +218,11 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, #' @export #' "plotterforGUI" <- function(modtype = "kin", X = matrix(), data, - model, theta = vector(), result, lin = NA, mu = 0, guessIRF = FALSE) { - ccs <- diverge_hcl(40, h = c(0, 120), c = 60, l = c(45, 90), - power = 1.2) + model, theta = vector(), result, lin = NA, mu = 0, guessIRF = FALSE) { + ccs <- diverge_hcl(40, + h = c(0, 120), c = 60, l = c(45, 90), + power = 1.2 + ) ## note that result is the return value of fitModel if ## modtype=='spec' or modtype == 'kin', and the return value ## of nls otherwise @@ -221,15 +245,21 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, svdobserved <- svd(observed) if (!is.null(model)) { - if (modtype == "kin" && length(model@irfpar) > 0) - mu <- unlist(parEst(result, param = "irfpar", dataset = 1, - verbose = F))[1] else { - if (modtype == "spectemp" && length(theta@irfpar) > 0) - mu <- head(theta@irfpar, 1) else mu <- 0 + if (modtype == "kin" && length(model@irfpar) > 0) { + mu <- unlist(parEst(result, + param = "irfpar", dataset = 1, + verbose = FALSE + ))[1] + } else { + if (modtype == "spectemp" && length(theta@irfpar) > 0) { + mu <- head(theta@irfpar, 1) + } else { + mu <- 0 + } } } else if (guessIRF) { lsv1 <- svd(data@psi.df)$u[, 1] - mu <- data@x[[floor((which(lsv1==min(lsv1))+which(lsv1==max(lsv1)))/2)]] + mu <- data@x[[floor((which(lsv1 == min(lsv1)) + which(lsv1 == max(lsv1))) / 2)]] } op <- par(no.readonly = TRUE) @@ -251,9 +281,14 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, if (is.na(lin)) { xnew <- x if (!modtype == "spec") { - if ((!is.null(model) && length(model@irfpar) > 0)) - lin <- max(pretty(abs(mu) * 10)) else lin <- max(data@x) - } else lin <- max(data@x) + if ((!is.null(model) && length(model@irfpar) > 0)) { + lin <- max(pretty(abs(mu) * 10)) + } else { + lin <- max(data@x) + } + } else { + lin <- max(data@x) + } } else { dolinlog <- TRUE xnew <- linloglines(x, mu = mu, alpha = lin) @@ -264,9 +299,12 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, if (!modtype == "spectemp") { residuals <- matrix(nrow = nt, ncol = nl) residlist <- result$currModel@fit@resultlist[[1]]@resid - for (j in 1:length(residlist)) { - if (modtype == "kin") - residuals[, j] <- residlist[[j]] else residuals[j, ] <- residlist[[j]] + for (j in seq_len(residlist)) { + if (modtype == "kin") { + residuals[, j] <- residlist[[j]] + } else { + residuals[j, ] <- residlist[[j]] + } } } else { residuals <- result$m$resid() @@ -279,9 +317,13 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, if (nt == 1) { - plot(x = x2, y = observed, xlab = "wavelength (nm)", - ylab = "", main = "Data", type = "l", xlim = c(min(x2), - max(x2))) + plot( + x = x2, y = observed, xlab = "wavelength (nm)", + ylab = "", main = "Data", type = "l", xlim = c( + min(x2), + max(x2) + ) + ) if (!is.null(model)) { lines(x = x2, y = observed - residuals[1, ], col = "red") } @@ -290,8 +332,10 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, ## linlogplot(x=x, y=observed, mu=mu, alpha=lin, xlab = 'time ## (ps)',ylab='', main = 'Data', type = 'l', xlim=c(min(x), ## max(x))) - plot(x = x, y = observed, xlab = "time (ps)", ylab = "", - main = "Data", type = "l", xlim = c(min(x), max(x))) + plot( + x = x, y = observed, xlab = "time (ps)", ylab = "", + main = "Data", type = "l", xlim = c(min(x), max(x)) + ) if (!is.null(model)) { lines(x = x, y = observed - residuals[, 1], col = "red") } @@ -300,44 +344,58 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, m <- par("mar") par(mar = c(m[1:3], 3)) if (dolinlog) { - image(xnew, x2, observed, ylab = "wavelength (nm)", + image(xnew, x2, observed, + ylab = "wavelength (nm)", xaxt = "n", main = "Data", xlab = "time (ps)", - col = ccs) + col = ccs + ) axis(1, at = newlab[, 1], labels = newlab[, 2]) # mtext(side = 1, newlab[,2], at= newlab[,1], line = 1) - image.plot(xnew, x2, observed, legend.only = TRUE, - col = ccs) + image.plot(xnew, x2, observed, + legend.only = TRUE, + col = ccs + ) } else { - image.plot(xnew, x2, observed, ylab = "wavelength (nm)", - main = "Data", xlab = "time (ps)", col = ccs) + image.plot(xnew, x2, observed, + ylab = "wavelength (nm)", + main = "Data", xlab = "time (ps)", col = ccs + ) } par(mar = m) # PLOT SVD DATA - plot(log10(svdobserved$d), main = "log(sing val. data)", - ylab = "") + plot(log10(svdobserved$d), + main = "log(sing val. data)", + ylab = "" + ) lsv1 <- svdobserved$u[, 1] # maxlsv1<-max(lsv1) minlsv1<-min(lsv1) # extrlsv1<-max(abs(maxlsv1),abs(minlsv1)) if (minlsv1 > 0) # minlsv1=0 if (maxlsv1 < 0) maxlsv1=0 if (dolinlog) { - linlogplot(x = x, y = lsv1, mu = mu, alpha = lin, + linlogplot( + x = x, y = lsv1, mu = mu, alpha = lin, main = "1st LSV data", xlab = "time (ps)", type = "l", - ylab = "", xlim = c(min(x), max(x)), ylim = c(min(lsv1, - 0), max(lsv1, 0))) + ylab = "", xlim = c(min(x), max(x)), ylim = c(min( + lsv1, + 0 + ), max(lsv1, 0)) + ) } else { - plot(x = x, y = lsv1, main = "1st LSV data", xlab = "time (ps)", + plot( + x = x, y = lsv1, main = "1st LSV data", xlab = "time (ps)", type = "l", ylab = "", xlim = c(min(x), max(x)), - ylim = c(min(lsv1, 0), max(lsv1, 0))) - + ylim = c(min(lsv1, 0), max(lsv1, 0)) + ) } abline(0, 0, lty = 3) - plot(x2, svdobserved$v[, 1], main = "1st RSV data", xlab = "wavelength (nm)", - type = "l", ylab = "") + plot(x2, svdobserved$v[, 1], + main = "1st RSV data", xlab = "wavelength (nm)", + type = "l", ylab = "" + ) abline(0, 0, lty = 3) # moved plotting of 2nd LSV and RSV after plotting of spectra - } @@ -345,9 +403,12 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, if (nt > 1) { # PLOT CONCENTRATIONS - if (!modtype == "spec") - C <- compModel(k = theta@kinpar, x = x, irfpar = theta@irfpar, - irf = model@irf, seqmod = model@seqmod) else { + if (!modtype == "spec") { + C <- compModel( + k = theta@kinpar, x = x, irfpar = theta@irfpar, + irf = model@irf, seqmod = model@seqmod + ) + } else { # modtype == 'spec' C <- X # assign('Cest',cbind(x, C), envir = globalenv()) @@ -355,59 +416,74 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, # if(lin == 0) # reversed plots - if (length(theta@irfpar)>0) { - if (theta@irfpar[2]>0) { + if (length(theta@irfpar) > 0) { + if (theta@irfpar[2] > 0) { irf_for_plotting <- dnorm(x, theta@irfpar[1], theta@irfpar[2]) - irf_for_plotting <- irf_for_plotting/max(irf_for_plotting)*max(C) + irf_for_plotting <- irf_for_plotting / max(irf_for_plotting) * max(C) } else { - irf_for_plotting <- rep(0,length(x)) + irf_for_plotting <- rep(0, length(x)) } } if (dolinlog) { - matlinlogplot(x, C, mu, lin, ylab = "", xlab = "time (ps)", - main = "Concentrations", type = "l", lty = 1) - if (length(theta@irfpar)>0) { - matlinlogplot(x, irf_for_plotting, mu, lin, type = "l", lty = 2, add = TRUE) + matlinlogplot(x, C, mu, lin, + ylab = "", xlab = "time (ps)", + main = "Concentrations", type = "l", lty = 1 + ) + if (length(theta@irfpar) > 0) { + matlinlogplot(x, irf_for_plotting, mu, lin, type = "l", lty = 2, add = TRUE) } } else { - matplot(x, C, xlab = "time (ps)", ylab = "", - main = "Concentrations", type = "l", lty = 1) - if (length(theta@irfpar)>0) { - matplot(x, irf_for_plotting, type = "l", lty = 2, add = TRUE) + matplot(x, C, + xlab = "time (ps)", ylab = "", + main = "Concentrations", type = "l", lty = 1 + ) + if (length(theta@irfpar) > 0) { + matplot(x, irf_for_plotting, type = "l", lty = 2, add = TRUE) } - } if (data@simdata) { if ((modtype == "kin") || (modtype == "spectemp")) { - amplitudes = data@amplitudes + amplitudes <- data@amplitudes ncomp <- length(amplitudes) - aC2 <- data@C2 %*% diag(1/amplitudes, ncomp, - ncomp) + aC2 <- data@C2 %*% diag( + 1 / amplitudes, ncomp, + ncomp + ) if (dolinlog) { - matlinlogplot(x = x, mu = mu, alpha = lin, - y = aC2, col = "blue", lty = 3, add = TRUE, - type = "l") + matlinlogplot( + x = x, mu = mu, alpha = lin, + y = aC2, col = "blue", lty = 3, add = TRUE, + type = "l" + ) } else { - matplot(x = x, y = aC2, col = "blue", lty = 3, - add = TRUE, type = "l") + matplot( + x = x, y = aC2, col = "blue", lty = 3, + add = TRUE, type = "l" + ) } } else { if (dolinlog) { - matlinlogplot(x = x, mu = mu, alpha = lin, - y = data@C2, col = "blue", lty = 3, add = TRUE, - type = "l") + matlinlogplot( + x = x, mu = mu, alpha = lin, + y = data@C2, col = "blue", lty = 3, add = TRUE, + type = "l" + ) } else { - matplot(x = x, y = data@C2, col = "blue", - lty = 3, add = TRUE, type = "l") + matplot( + x = x, y = data@C2, col = "blue", + lty = 3, add = TRUE, type = "l" + ) } } } abline(0, 0, lty = 3) } else { - barplot(X[1, ], main = "Amplitudes", ylab = "", xlab = "component", - lty = 1) + barplot(X[1, ], + main = "Amplitudes", ylab = "", xlab = "component", + lty = 1 + ) } if (nl > 1) { # PLOT SPECTRA @@ -416,72 +492,107 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, E <- X # assign('Eest',cbind(x2, E), envir = globalenv()) } - if (modtype == "spec") - E <- calcEhiergaus(lambda = x2, theta = theta@specpar, - nupower = 1) - if (modtype == "spectemp") + if (modtype == "spec") { + E <- calcEhiergaus( + lambda = x2, theta = theta@specpar, + nupower = 1 + ) + } + if (modtype == "spectemp") { E <- calcE(lambda = x2, theta = unlist(theta@specpar)) + } - matplot(x2, E, main = "Spectra", ylab = "", xlab = "wavelength (nm)", - type = "l", lty = 1) + matplot(x2, E, + main = "Spectra", ylab = "", xlab = "wavelength (nm)", + type = "l", lty = 1 + ) abline(0, 0, lty = 3) - if (data@simdata) + if (data@simdata) { if (modtype == "kin") { - aE2 <- data@E2 %*% diag(amplitudes, ncomp, - ncomp) + aE2 <- data@E2 %*% diag( + amplitudes, ncomp, + ncomp + ) matlines(x2, aE2, lty = 3, col = "blue") } else { matlines(x2, data@E2, lty = 3, col = "blue") } + } } else { - barplot(X[1, ], main = "Amplitudes", ylab = "", xlab = "component", - lty = 1) + barplot(X[1, ], + main = "Amplitudes", ylab = "", xlab = "component", + lty = 1 + ) } # Moved 2nd LSV and RSV here: if (nt > 1 && nl > 1) { if (dolinlog) { - linlogplot(x = x, y = svdobserved$u[, 2], mu = mu, - alpha = lin, main = "2nd LSV data", xlab = "time (ps)", - type = "l", ylab = "", xlim = c(min(x), max(x))) + linlogplot( + x = x, y = svdobserved$u[, 2], mu = mu, + alpha = lin, main = "2nd LSV data", xlab = "time (ps)", + type = "l", ylab = "", xlim = c(min(x), max(x)) + ) } else { - plot(x = x, y = svdobserved$u[, 2], main = "2nd LSV data", - xlab = "time (ps)", type = "l", ylab = "", xlim = c(min(x), - max(x))) + plot( + x = x, y = svdobserved$u[, 2], main = "2nd LSV data", + xlab = "time (ps)", type = "l", ylab = "", xlim = c( + min(x), + max(x) + ) + ) } abline(0, 0, lty = 3) - plot(x2, svdobserved$v[, 2], main = "2nd RSV data", xlab = "wavelength (nm)", - type = "l", ylab = "") + plot(x2, svdobserved$v[, 2], + main = "2nd RSV data", xlab = "wavelength (nm)", + type = "l", ylab = "" + ) abline(0, 0, lty = 3) } # PLOT RESIDS if (nt == 1) { - plot(x = x2, y = residuals[1, ], xlab = "wavelength (nm)", - ylab = "", main = "Residuals", type = "l", xlim = c(min(x2), - max(x2))) + plot( + x = x2, y = residuals[1, ], xlab = "wavelength (nm)", + ylab = "", main = "Residuals", type = "l", xlim = c( + min(x2), + max(x2) + ) + ) abline(0, 0) } else { if (nl == 1) { - linlogplot(x = x, y = residuals[, 1], mu = mu, + linlogplot( + x = x, y = residuals[, 1], mu = mu, alpha = lin, xlab = "time (ps)", ylab = "", - main = "Residuals", type = "l", xlim = c(min(x), - max(x))) + main = "Residuals", type = "l", xlim = c( + min(x), + max(x) + ) + ) abline(0, 0) } else { m <- par("mar") par(mar = c(m[1:3], 3)) if (dolinlog) { - image(xnew, x2, residuals, ylab = "wavelength (nm)", - xaxt = "n", main = "Residuals", col = ccs, - xlab = "time (ps)") - axis(1, at = newlab[, 1], labels = newlab[, - 2]) - image.plot(xnew, x2, residuals, ylab = "wavelength (nm)", - legend.only = TRUE, main = "Residuals", col = ccs) + image(xnew, x2, residuals, + ylab = "wavelength (nm)", + xaxt = "n", main = "Residuals", col = ccs, + xlab = "time (ps)" + ) + axis(1, at = newlab[, 1], labels = newlab[ + , + 2 + ]) + image.plot(xnew, x2, residuals, + ylab = "wavelength (nm)", + legend.only = TRUE, main = "Residuals", col = ccs + ) } else { - image.plot(xnew, x2, residuals, ylab = "wavelength (nm)", - main = "Residuals", col = ccs, xlab = "time (ps)") + image.plot(xnew, x2, residuals, + ylab = "wavelength (nm)", + main = "Residuals", col = ccs, xlab = "time (ps)" + ) } par(mar = m) svdresid <- svd(residuals) @@ -489,30 +600,39 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, lenlogsvd <- length(logsvd) nsingvalres <- lenlogsvd - dim(E)[2] - plot(logsvd[1:nsingvalres], main = "log(sing. val. resid.)", - ylab = "") - linlogplot(x = x, y = svdresid$u[, 1], mu = mu, + plot(logsvd[1:nsingvalres], + main = "log(sing. val. resid.)", + ylab = "" + ) + linlogplot( + x = x, y = svdresid$u[, 1], mu = mu, alpha = lin, main = "1st LSV resid.", xlab = "time (ps)", - type = "l", ylab = "", xlim = c(min(x), max(x))) + type = "l", ylab = "", xlim = c(min(x), max(x)) + ) abline(0, 0, lty = 3) - plot(x2, svdresid$v[, 1], main = "1st RSV resid", - xlab = "wavelength (nm)", type = "l", ylab = "") + plot(x2, svdresid$v[, 1], + main = "1st RSV resid", + xlab = "wavelength (nm)", type = "l", ylab = "" + ) abline(0, 0, lty = 3) } } # ADD TITLE if (!modtype == "spec") { kinest <- paste("Kin par:", toString(signif(theta@kinpar, - digits = 4))) - if (length(theta@irfpar) > 0) + digits = 4 + ))) + if (length(theta@irfpar) > 0) { kinest <- paste(kinest, " IRF par:", toString(signif(theta@irfpar, - digits = 4))) + digits = 4 + ))) + } mtext(kinest, side = 3, outer = TRUE, line = 1) - } if (!modtype == "kin") { specest <- paste("Spec par:", toString(signif(unlist(theta@specpar), - digits = 4))) + digits = 4 + ))) mtext(specest, side = 3, outer = TRUE, line = -0.5) } } @@ -520,7 +640,6 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, par(op) # try 20111104 tkdestroy(winmodel) this only kills one # winmodel ... - } #' Simulate data @@ -569,14 +688,14 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, #' @export #' "simndecay_gen_paramGUI" <- function(kinpar, tmax, deltat, specpar = vector(), - lmin, lmax, deltal, sigma, irf = FALSE, irfpar = vector(), - seqmod = FALSE, dispmu = FALSE, nocolsums = FALSE, disptau = FALSE, - parmu = list(), partau = vector(), lambdac = 0, fullk = FALSE, - kmat = matrix(), jvec = vector(), specfun = "gaus", nupow = 1, - irffun = "gaus", kinscal = vector(), lightregimespec = list(), - specdisp = FALSE, specdisppar = list(), parmufunc = "exp", - specdispindex = list(), amplitudes = vector(), specref = 0, - nosiminfo = TRUE) { + lmin, lmax, deltal, sigma, irf = FALSE, irfpar = vector(), + seqmod = FALSE, dispmu = FALSE, nocolsums = FALSE, disptau = FALSE, + parmu = list(), partau = vector(), lambdac = 0, fullk = FALSE, + kmat = matrix(), jvec = vector(), specfun = "gaus", nupow = 1, + irffun = "gaus", kinscal = vector(), lightregimespec = list(), + specdisp = FALSE, specdisppar = list(), parmufunc = "exp", + specdispindex = list(), amplitudes = vector(), specref = 0, + nosiminfo = TRUE) { if (tmax > 0) { x <- seq(0, tmax, deltat) } else { @@ -592,9 +711,11 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, ## issue EList <- list() for (i in 1:nt) { - sp <- specparF(specpar = specpar, xi = x[i], i = i, + sp <- specparF( + specpar = specpar, xi = x[i], i = i, specref = specref, specdispindex = specdispindex, - specdisppar = specdisppar, parmufunc = parmufunc) + specdisppar = specdisppar, parmufunc = parmufunc + ) EList[[i]] <- calcEhiergaus(sp, x2, nupow) } } else if (lmin == lmax) { @@ -609,10 +730,12 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, C2 <- matrix(amplitudes, nrow = 1, ncol = ncomp) # TODO: set modType to 0? } else { - C2 <- compModel(k = kinpar, x = x, irfpar = irfpar, + C2 <- compModel( + k = kinpar, x = x, irfpar = irfpar, irf = irf, seqmod = seqmod, fullk = fullk, kmat = kmat, jvec = jvec, amplitudes = amplitudes, lightregimespec = lightregimespec, - nocolsums = nocolsums, kinscal = kinscal) + nocolsums = nocolsums, kinscal = kinscal + ) } if (specdisp) { psisim <- matrix(nrow = nt, ncol = nl) @@ -620,17 +743,23 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, for (i in 1:nt) { psisim[i, ] <- t(as.matrix(C2[i, ])) %*% t(EList[[i]]) } - } else psisim <- C2 %*% t(E2) + } else { + psisim <- C2 %*% t(E2) + } } else { psisim <- matrix(nrow = nt, ncol = nl) for (i in 1:nl) { - irfvec <- irfparF(irfpar, lambdac, x2[i], i, dispmu, - parmu, disptau, partau, "", "", "gaus") + irfvec <- irfparF( + irfpar, lambdac, x2[i], i, dispmu, + parmu, disptau, partau, "", "", "gaus" + ) - C2 <- compModel(k = kinpar, x = x, irfpar = irfpar, + C2 <- compModel( + k = kinpar, x = x, irfpar = irfpar, irf = irf, seqmod = seqmod, fullk = fullk, kmat = kmat, jvec = jvec, amplitudes = amplitudes, lightregimespec = lightregimespec, - nocolsums = nocolsums, kinscal = kinscal) + nocolsums = nocolsums, kinscal = kinscal + ) psisim[, i] <- C2 %*% cbind(E2[i, ]) } } @@ -639,15 +768,19 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, dim(psi.df) <- c(nt, nl) if (nosiminfo) { - dat(psi.df = psi.df, x = x, nt = nt, x2 = x2, nl = nl, - simdata = FALSE) + dat( + psi.df = psi.df, x = x, nt = nt, x2 = x2, nl = nl, + simdata = FALSE + ) } else { - kin(psi.df = psi.df, x = x, nt = nt, x2 = x2, nl = nl, + kin( + psi.df = psi.df, x = x, nt = nt, x2 = x2, nl = nl, C2 = C2, E2 = E2, kinpar = kinpar, specpar = specpar, seqmod = seqmod, irf = irf, irfpar = irfpar, dispmu = dispmu, disptau = disptau, parmu = parmu, partau = partau, lambdac = lambdac, simdata = TRUE, fullk = fullk, - kmat = kmat, jvec = jvec, amplitudes = amplitudes) + kmat = kmat, jvec = jvec, amplitudes = amplitudes + ) } } diff --git a/R/runApp.R b/R/runApp.R index 54c7ab2..dc9758d 100644 --- a/R/runApp.R +++ b/R/runApp.R @@ -9,7 +9,6 @@ #' runGUI() #' } #' -#' runGUI <- function() { appDir <- system.file("shinyApps", "paramGUI", package = "paramGUI") if (appDir == "") { diff --git a/R/utility.R b/R/utility.R index cb242f0..c39ccbe 100644 --- a/R/utility.R +++ b/R/utility.R @@ -16,13 +16,17 @@ #' #' @return boolean, TRUE if the file is compressed #' -is_compressed <- function(filename, magic.number=as.raw(c("0x1f","0x8b"))) { - fh<-file(filename, "rb") +is_compressed <- function(filename, magic.number = as.raw(c("0x1f", "0x8b"))) { + fh <- file(filename, "rb") on.exit(close(fh)) magic <- readBin(fh, "raw", length(magic.number)) - if(length(magic) != length(magic.number)) return(FALSE) - if(all(magic == magic.number)) return(TRUE) - return (FALSE) + if (length(magic) != length(magic.number)) { + return(FALSE) + } + if (all(magic == magic.number)) { + return(TRUE) + } + return(FALSE) } #' is_rdata @@ -35,19 +39,23 @@ is_compressed <- function(filename, magic.number=as.raw(c("0x1f","0x8b"))) { #' @export #' is_rdata <- function(filename) { - #check for magic number - #https://github.com/wch/r-source/blob/b99d403f4b7337553acb2d2108c7a00e6c19f908/src/main/saveload.c#L1786 + # check for magic number + # https://github.com/wch/r-source/blob/b99d403f4b7337553acb2d2108c7a00e6c19f908/src/main/saveload.c#L1786 - fh <- if(!is_compressed(filename)) + fh <- if (!is_compressed(filename)) { file(filename, "rb") - else { + } else { gzfile(filename, "rb") } on.exit(close(fh)) magic <- rawToChar(readBin(fh, "raw", 5)) - if(nchar(magic)<5) return(FALSE) - if(magic %in% c("RDA1\n","RDB1\n","RDX1\n","RDA2\n","RDB2\n","RDX2\n","RDA3\n","RDB3\n","RDX3\n")) return(TRUE) - return (FALSE) + if (nchar(magic) < 5) { + return(FALSE) + } + if (magic %in% c("RDA1\n", "RDB1\n", "RDX1\n", "RDA2\n", "RDB2\n", "RDX2\n", "RDA3\n", "RDB3\n", "RDX3\n")) { + return(TRUE) + } + return(FALSE) } diff --git a/inst/shinyApps/paramGUI/app.R b/inst/shinyApps/paramGUI/app.R index cc71142..fd9e418 100644 --- a/inst/shinyApps/paramGUI/app.R +++ b/inst/shinyApps/paramGUI/app.R @@ -29,7 +29,7 @@ library(shinydashboard) #' newSpecList <- function(spec_loc, spec_wid, spec_b) { specvec <- vector("list", length(spec_loc)) - for(i in 1:length(spec_loc)){ + for (i in 1:length(spec_loc)) { specvec[[i]][1] <- as.double(spec_loc[i]) specvec[[i]][2] <- as.double(spec_wid[i]) specvec[[i]][3] <- as.double(spec_b[i]) @@ -38,13 +38,12 @@ newSpecList <- function(spec_loc, spec_wid, spec_b) { } ui <- dashboardPage( - dashboardHeader(title = "paramGUI"), # Remove ), from this line an uncomment the next to enable notifcation menu. # dropdownMenuOutput("messageMenu"),dropdownMenuOutput("notificationMenu")), dashboardSidebar( - tags$head(tags$style(HTML(' + tags$head(tags$style(HTML(" /* Change padding of sub-menu items */ .row { margin-right: 5px; @@ -83,112 +82,139 @@ ui <- dashboardPage( } - '))), - + "))), tabsetPanel( - tabPanel("Simulate", - textInput("simDecayRates", label = "Decay rates: ", value = "0.055,0.005"), - textInput("simAmplitudes", label = "Amplitudes: ", value = "1.,1."), - textInput("simSpecLoc", label = div(HTML("Location (mean) of spectra (cm-1):")), value = "22000,20000"), - textInput("simSpecWidth", label = div(HTML("Width of spectra (cm-1):")), value = "4000,3500"), - textInput("simSpecSkew", label = "Skewness of spectra:", value = "0.1, -0.1"), - fluidRow( - column(8,textInput("simMaxTime", label = "Timepoints, max:", value = "80")), - column(4,textInput("simTimeStep", label = "stepsize:", value = "1")) - ), - fluidRow( - column(12,HTML("Wavelength (nm):"))), - fluidRow( - column(4, - textInput("simMinWavelength", label = "Min:", value = "400")), - column(4, - textInput("simMaxWavelength", label = "Max:", value = "600")), - column(4, - textInput("simWavelengthStepSize", label = "Stepsize:", value = "5")) - ), - fluidRow( - column(6,textInput("simFracNoise", label = "Stdev. noise:", value = "1E-2")), - column(6,numericInput("simSeed", label = "Seed:", value = "123", min = 0, step = 1)) - ), - checkboxInput("simEnableIRF", label = "Add Gaussian IRF", value = FALSE, width = NULL), - conditionalPanel(condition = "(input.simEnableIRF== true)", - fluidRow( - column(6,textInput("simLocIRF", label = "IRF Location:", value = "2.0")), - column(6,textInput("simWidthIRF", label = "IRF Width:", value = "1.0")) - )), - checkboxInput("simSeqmod", label = "Use a sequential scheme", value = FALSE, width = NULL), - actionButton("simButton", "Simulate") - - ), #end of Simulate tab - - tabPanel("Fitting", - selectInput("modelType", label = h5("Select a model type"), - choices = list("Kinetic" = "kin", "Spectral" = "spec", "Spectrotemporal" = "spectemp"), - selected = "kin"), - conditionalPanel(condition = "(input.modelType=='kin' || input.modelType=='spectemp')", - textInput("fitDecayRates", label = "Decay rates: ", value = "0.055,0.005") - ), - conditionalPanel(condition = "(input.modelType=='spec' || input.modelType=='spectemp')", - textInput("fitSpecLoc", label = "Location (mean) of spectra:", value = "22000,20000"), - textInput("fitSpecWidth", label = "Width of spectra:", value = "4000,3500"), - textInput("fitSpecSkew", label = "Skewness of spectra:", value = "0.1, -0.1") - ), - conditionalPanel(condition = "(input.modelType=='kin' || input.modelType=='spectemp')", - fluidRow( - column(6,checkboxInput("fitEnableIRF", label = "Gaussian IRF", value = FALSE, width = NULL)), - column(6,checkboxInput("fitEnableStreak", label = "Backsweep?", value = FALSE)) - ), - conditionalPanel(condition = "(input.fitEnableIRF== true)", - fluidRow( - column(6,textInput("fitLocIRF", label = "IRF Location:", value = "2.0")), - column(6,textInput("fitWidthIRF", label = "IRF Width:", value = "1.0")) - )), - checkboxInput("fitSeqmod", label = "Use a sequential scheme", value = FALSE, width = NULL), - checkboxInput("fitPosDec", label = "Force positive decay rates", value = FALSE, width = NULL) - ), - conditionalPanel(condition = "(input.modelType=='spectemp')", - checkboxInput("fitKroncol", label = "Single amplitude per component", value = FALSE, width = NULL)), - numericInput("fitLinAxis", label = "Linear-Log axis (0 for linear):", value = 0, min = 0), - numericInput("fitNumIters", label = "Max. number of iterations:", value = "7", min = 0, max = 99, step = 1), - - # uiOutput("specControls"), - #conditionalPanel(condition = '!input.fitButton', - # helpText("Note: you might need to increase the number of iterations to reach convergence") - #) - #, - fluidRow( - column(6,actionButton("fitButton", "Fit model")), - column(6,conditionalPanel(condition = 'input.fitButton', - actionButton("updateModelButton", "Update model"))) - ), - conditionalPanel(condition = 'input.fitButton', - helpText("Update model updates the input field with the results from your last fit."))), - tabPanel("I/O", - h4("Load data"), - fileInput("loadData",label=NULL), - tags$script('$( "#loadData" ).on( "click", function() { this.value = null; });'), - tags$script('$(document).on("keypress", function (e) { Shiny.onInputChange("keyPressed", [e.which,e.timeStamp]); });'), - # http://stackoverflow.com/questions/34441584/re-upload-same-file-shiny-r - # TODO: http://stackoverflow.com/questions/17352086/how-can-i-update-a-shiny-fileinput-object - actionButton('loadDefaultDataButton', label = "Load Default Data"), - h4("Save data"), - conditionalPanel(condition = '!input.simButton', - helpText("Note: once you have simulated data the option to save your data locally or export (download) your data will appear here.")), - conditionalPanel(condition = 'input.simButton', - textInput("simFilename", label = "Base filename:", value = "sim"), - fluidRow( - column(6,actionButton('saveDataButton', label = "Save")), - column(6,downloadButton('downloadData', label = "Download")) - ), - helpText("The save button will save your data to your home/documents folder, the download button will allow your to download the file (but only in a real browser).") - ) - + tabPanel( + "Simulate", + textInput("simDecayRates", label = "Decay rates: ", value = "0.055,0.005"), + textInput("simAmplitudes", label = "Amplitudes: ", value = "1.,1."), + textInput("simSpecLoc", label = div(HTML("Location (mean) of spectra (cm-1):")), value = "22000,20000"), + textInput("simSpecWidth", label = div(HTML("Width of spectra (cm-1):")), value = "4000,3500"), + textInput("simSpecSkew", label = "Skewness of spectra:", value = "0.1, -0.1"), + fluidRow( + column(8, textInput("simMaxTime", label = "Timepoints, max:", value = "80")), + column(4, textInput("simTimeStep", label = "stepsize:", value = "1")) + ), + fluidRow( + column(12, HTML("Wavelength (nm):")) + ), + fluidRow( + column( + 4, + textInput("simMinWavelength", label = "Min:", value = "400") + ), + column( + 4, + textInput("simMaxWavelength", label = "Max:", value = "600") + ), + column( + 4, + textInput("simWavelengthStepSize", label = "Stepsize:", value = "5") + ) + ), + fluidRow( + column(6, textInput("simFracNoise", label = "Stdev. noise:", value = "1E-2")), + column(6, numericInput("simSeed", label = "Seed:", value = "123", min = 0, step = 1)) + ), + checkboxInput("simEnableIRF", label = "Add Gaussian IRF", value = FALSE, width = NULL), + conditionalPanel( + condition = "(input.simEnableIRF== true)", + fluidRow( + column(6, textInput("simLocIRF", label = "IRF Location:", value = "2.0")), + column(6, textInput("simWidthIRF", label = "IRF Width:", value = "1.0")) + ) + ), + checkboxInput("simSeqmod", label = "Use a sequential scheme", value = FALSE, width = NULL), + actionButton("simButton", "Simulate") + ), # end of Simulate tab + + tabPanel( + "Fitting", + selectInput("modelType", + label = h5("Select a model type"), + choices = list("Kinetic" = "kin", "Spectral" = "spec", "Spectrotemporal" = "spectemp"), + selected = "kin" + ), + conditionalPanel( + condition = "(input.modelType=='kin' || input.modelType=='spectemp')", + textInput("fitDecayRates", label = "Decay rates: ", value = "0.055,0.005") + ), + conditionalPanel( + condition = "(input.modelType=='spec' || input.modelType=='spectemp')", + textInput("fitSpecLoc", label = "Location (mean) of spectra:", value = "22000,20000"), + textInput("fitSpecWidth", label = "Width of spectra:", value = "4000,3500"), + textInput("fitSpecSkew", label = "Skewness of spectra:", value = "0.1, -0.1") + ), + conditionalPanel( + condition = "(input.modelType=='kin' || input.modelType=='spectemp')", + fluidRow( + column(6, checkboxInput("fitEnableIRF", label = "Gaussian IRF", value = FALSE, width = NULL)), + column(6, checkboxInput("fitEnableStreak", label = "Backsweep?", value = FALSE)) + ), + conditionalPanel( + condition = "(input.fitEnableIRF== true)", + fluidRow( + column(6, textInput("fitLocIRF", label = "IRF Location:", value = "2.0")), + column(6, textInput("fitWidthIRF", label = "IRF Width:", value = "1.0")) + ) + ), + checkboxInput("fitSeqmod", label = "Use a sequential scheme", value = FALSE, width = NULL), + checkboxInput("fitPosDec", label = "Force positive decay rates", value = FALSE, width = NULL) + ), + conditionalPanel( + condition = "(input.modelType=='spectemp')", + checkboxInput("fitKroncol", label = "Single amplitude per component", value = FALSE, width = NULL) + ), + numericInput("fitLinAxis", label = "Linear-Log axis (0 for linear):", value = 0, min = 0), + numericInput("fitNumIters", label = "Max. number of iterations:", value = "7", min = 0, max = 99, step = 1), + + # uiOutput("specControls"), + # conditionalPanel(condition = '!input.fitButton', + # helpText("Note: you might need to increase the number of iterations to reach convergence") + # ) + # , + fluidRow( + column(6, actionButton("fitButton", "Fit model")), + column(6, conditionalPanel( + condition = "input.fitButton", + actionButton("updateModelButton", "Update model") + )) + ), + conditionalPanel( + condition = "input.fitButton", + helpText("Update model updates the input field with the results from your last fit.") + ) + ), + tabPanel( + "I/O", + h4("Load data"), + fileInput("loadData", label = NULL), + tags$script('$( "#loadData" ).on( "click", function() { this.value = null; });'), + tags$script('$(document).on("keypress", function (e) { Shiny.onInputChange("keyPressed", [e.which,e.timeStamp]); });'), + # http://stackoverflow.com/questions/34441584/re-upload-same-file-shiny-r + # TODO: http://stackoverflow.com/questions/17352086/how-can-i-update-a-shiny-fileinput-object + actionButton("loadDefaultDataButton", label = "Load Default Data"), + h4("Save data"), + conditionalPanel( + condition = "!input.simButton", + helpText("Note: once you have simulated data the option to save your data locally or export (download) your data will appear here.") + ), + conditionalPanel( + condition = "input.simButton", + textInput("simFilename", label = "Base filename:", value = "sim"), + fluidRow( + column(6, actionButton("saveDataButton", label = "Save")), + column(6, downloadButton("downloadData", label = "Download")) + ), + helpText("The save button will save your data to your home/documents folder, the download button will allow your to download the file (but only in a real browser).") + ) ) - ), width = 300), - + ), + width = 300 + ), dashboardBody( # Boxes need to be put in a row (or column) - tags$head(tags$style(HTML(' + tags$head(tags$style(HTML(" /* Change padding of sub-menu items */ .sidebar .sidebar-menu .treeview-menu>li>a { padding: 5px 5px 5px 8px; @@ -204,35 +230,38 @@ ui <- dashboardPage( overflow-x: auto; word-wrap: normal; } - '))), + "))), fluidRow( - tabBox(title = "RESULTS", - id = "outputTabs", height = "700px", width = "670px", - tabPanel("Data", - plotOutput("dataPlot", height = 650, width = 900) - #,checkboxInput("advPlotting", NULL, value = FALSE, width = NULL) - ), - tabPanel("Fit progression", - verbatimTextOutput("fitProgressOutput")), - tabPanel("Fit results", - plotOutput("fitPlot", height = 650, width = 900) - ), - # http://stackoverflow.com/questions/19470426/r-shiny-add-tabpanel-to-tabsetpanel-dynamicaly-with-the-use-of-renderui - #conditionalPanel(condition = 'input.fitButton', - tabPanel("Diagnostics", - verbatimTextOutput("consoleOutput"), - actionButton("printSummaryButton", "Print summary") - ) - #) - + tabBox( + title = "RESULTS", + id = "outputTabs", height = "700px", width = "670px", + tabPanel( + "Data", + plotOutput("dataPlot", height = 650, width = 900) + # ,checkboxInput("advPlotting", NULL, value = FALSE, width = NULL) + ), + tabPanel( + "Fit progression", + verbatimTextOutput("fitProgressOutput") + ), + tabPanel( + "Fit results", + plotOutput("fitPlot", height = 650, width = 900) + ), + # http://stackoverflow.com/questions/19470426/r-shiny-add-tabpanel-to-tabsetpanel-dynamicaly-with-the-use-of-renderui + # conditionalPanel(condition = 'input.fitButton', + tabPanel( + "Diagnostics", + verbatimTextOutput("consoleOutput"), + actionButton("printSummaryButton", "Print summary") + ) + # ) ) ) - ) ) server <- function(input, output, session) { - rvs <- reactiveValues() rvs$guessIRF <- FALSE rvs$nosiminfo <- TRUE @@ -242,17 +271,17 @@ server <- function(input, output, session) { # if((input$modelType == "kin" || input$modelType == "spectemp")) { # # } - #}) + # }) output$downloadData <- downloadHandler( filename = function() { timestamp <- format(Sys.time(), "%Y%m%d_%H%M") - paste0(isolate(input$simFilename),"-",timestamp,'.rds', sep='') + paste0(isolate(input$simFilename), "-", timestamp, ".rds", sep = "") }, content = function(file) { sim <- isolate(rvs$simData) - save(sim, file=file) - #saveRDS(isolate(rvs$simData), file) + save(sim, file = file) + # saveRDS(isolate(rvs$simData), file) } ) @@ -263,46 +292,47 @@ server <- function(input, output, session) { # that messageData is a data frame with two columns, 'from' and 'message'. # msgs <- apply(messageData, 1, function(row) { # messageItem(from = row[["from"]], message = row[["message"]]) - #}) + # }) # This is equivalent to calling: # dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...) - dropdownMenu(type = "messages", - messageItem( - from = "Administrator", - message = "Please register" - ) - # .list = msgs + dropdownMenu( + type = "messages", + messageItem( + from = "Administrator", + message = "Please register" + ) + # .list = msgs ) }) output$notificationMenu <- renderMenu({ - dropdownMenu(type = "notifications", - messageItem( - from = "New User", - message = "How do I register?", - icon = icon("question"), - time = "13:45" - ), - notificationItem( - text = "Server load at 86%", - icon = icon("exclamation-triangle"), - status = "warning" - ) - # .list = msgs + dropdownMenu( + type = "notifications", + messageItem( + from = "New User", + message = "How do I register?", + icon = icon("question"), + time = "13:45" + ), + notificationItem( + text = "Server load at 86%", + icon = icon("exclamation-triangle"), + status = "warning" + ) + # .list = msgs ) }) observeEvent(input$simButton, { - - updateTabsetPanel(session,"outputTabs",selected="Data" ) + updateTabsetPanel(session, "outputTabs", selected = "Data") set.seed(isolate(input$simSeed)) validInput <- TRUE - kinpar <- as.double(strsplit(isolate(input$simDecayRates),",")[[1]]) - amplitudes <- as.double(strsplit(input$simAmplitudes,",")[[1]]) + kinpar <- as.double(strsplit(isolate(input$simDecayRates), ",")[[1]]) + amplitudes <- as.double(strsplit(input$simAmplitudes, ",")[[1]]) spec_loc <- strsplit(isolate(input$simSpecLoc), ",")[[1]] spec_wid <- strsplit(isolate(input$simSpecWidth), ",")[[1]] spec_b <- strsplit(isolate(input$simSpecSkew), ",")[[1]] @@ -311,7 +341,15 @@ server <- function(input, output, session) { lmin <- as.double(isolate(input$simMinWavelength)) lmax <- as.double(isolate(input$simMaxWavelength)) linAxis <- isolate(input$fitLinAxis) - linr <- if(is.na(linAxis)) {NA} else {if(linAxis<0.1) {NA} else {linAxis}} + linr <- if (is.na(linAxis)) { + NA + } else { + if (linAxis < 0.1) { + NA + } else { + linAxis + } + } deltal <- as.double(isolate(input$simWavelengthStepSize)) sigma <- as.double(gsub(",", ".", isolate(input$simFracNoise))) irf <- isolate(input$simEnableIRF) @@ -320,287 +358,312 @@ server <- function(input, output, session) { seqmod <- isolate(input$simSeqmod) specvec <- newSpecList(spec_loc, spec_wid, spec_b) - if(rvs$DEBUG) { + if (rvs$DEBUG) { cat("# Simulating data with function call: \n") - cat("simndecay_gen_paramGUI(kinpar =",deparse(kinpar),",", - "amplitudes = ",deparse(amplitudes),",", - "tmax = ", tmax,",", - "deltat= ", deltat,",", - "specpar= ", deparse(specvec), ",", - "lmin= ", lmin,",", - "lmax= ", lmax,",", - "deltal= ", deltal,",", - "sigma= ", sigma,",", - "irf = ", irf,",", - "irfpar = c(",irfloc,",",irfwidth,")",",", - "seqmod =",seqmod,")\n") + cat( + "simndecay_gen_paramGUI(kinpar =", deparse(kinpar), ",", + "amplitudes = ", deparse(amplitudes), ",", + "tmax = ", tmax, ",", + "deltat= ", deltat, ",", + "specpar= ", deparse(specvec), ",", + "lmin= ", lmin, ",", + "lmax= ", lmax, ",", + "deltal= ", deltal, ",", + "sigma= ", sigma, ",", + "irf = ", irf, ",", + "irfpar = c(", irfloc, ",", irfwidth, ")", ",", + "seqmod =", seqmod, ")\n" + ) } - if(is.na(lmin) || is.na(lmax) || is.na(tmax) || is.na(deltal)) { + if (is.na(lmin) || is.na(lmax) || is.na(tmax) || is.na(deltal)) { validInput <- FALSE output$dataPlot <- renderPlot({ - plotMessage("Error: invalid timepoints or wavelength specification","red") + plotMessage("Error: invalid timepoints or wavelength specification", "red") }) } - inputList <- list(kinpar,amplitudes,spec_loc,spec_wid,spec_b) - if(!length(unique(sapply(inputList,length)))==1) { + inputList <- list(kinpar, amplitudes, spec_loc, spec_wid, spec_b) + if (!length(unique(sapply(inputList, length))) == 1) { validInput <- FALSE output$dataPlot <- renderPlot({ - plotMessage("Error: parameter fields of unequal length","red") + plotMessage("Error: parameter fields of unequal length", "red") }) } - if(validInput) { - rvs$simData <- simndecay_gen_paramGUI(kinpar=kinpar, - amplitudes = amplitudes, - tmax=tmax, - deltat=deltat, - specpar=specvec, - lmin=lmin, - lmax=lmax, - deltal=deltal, - sigma=sigma, - irf = irf,irfpar = c(irfloc,irfwidth), - seqmod = seqmod, - nosiminfo = isolate(rvs$nosiminfo)) + if (validInput) { + rvs$simData <- simndecay_gen_paramGUI( + kinpar = kinpar, + amplitudes = amplitudes, + tmax = tmax, + deltat = deltat, + specpar = specvec, + lmin = lmin, + lmax = lmax, + deltal = deltal, + sigma = sigma, + irf = irf, irfpar = c(irfloc, irfwidth), + seqmod = seqmod, + nosiminfo = isolate(rvs$nosiminfo) + ) # assign(".sim", isolate(rvs$simData) , globalenv()) updateDataPlot(irfloc, linr) } else { - cat("Invalid simulation input. No data was generated!", file=stderr()) + cat("Invalid simulation input. No data was generated!", file = stderr()) } - }) observeEvent(input$fitButton, { - - withProgress({ - ## This works with a function like message - ##withCallingHandlers({ - ##shinyjs::html("fitProgressOutput","") - ## - - updateTabsetPanel(session,"outputTabs",selected="Fit progression" ) - - kinpar <- as.double(strsplit(isolate(input$fitDecayRates),",")[[1]]) - spec_loc <- strsplit(isolate(input$fitSpecLoc), ",")[[1]] - spec_wid <- strsplit(isolate(input$fitSpecWidth), ",")[[1]] - spec_b <- strsplit(isolate(input$fitSpecSkew), ",")[[1]] - specvec <- newSpecList(spec_loc, spec_wid, spec_b) - kroncol <- input$fitKroncol - irf <- input$fitEnableIRF - irfloc <- as.double(isolate(input$fitLocIRF)) - irfwidth <- as.double(isolate(input$fitWidthIRF)) - irfpar <- c(irfloc, irfwidth) - seqmod <- input$fitSeqmod - positivepar <- input$fitPosDec - streak <- input$fitEnableStreak - rvs$modelType <- input$modelType - linAxis <- isolate(input$fitLinAxis) - linr <- if(is.na(linAxis)) {NA} else {if(linAxis<0.1) {NA} else {linAxis}} - iters <- isolate(input$fitNumIters) - - isolate({ - - if((isolate(rvs$modelType)=="kin")) { - output$fitProgressOutput <- renderPrint({ - rvs$kinModel <- initModel(mod_type = "kin", kinpar = kinpar, irf = irf, - irfpar = if(irf) irfpar else vector(), - streak = streak, - streakT = 13164.8235, - positivepar = if(positivepar) c("kinpar") else vector(), - seqmod=seqmod) - - rvs$kinFit <- fitModel(data=list(isolate(rvs$simData)), modspec=list(isolate(rvs$kinModel)),opt=kinopt(iter=iters, plot=FALSE)) - rvs$kinFitSummary <- summary(isolate(rvs$kinFit)$currModel@fit@nlsres[[1]], - currModel=isolate(rvs$kinFit)$currModel, - currTheta=isolate(rvs$kinFit)$currTheta, - correlation=TRUE) - updateConsole(isolate(rvs$modelType)) - updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr)) - }) - - } else if(isolate(rvs$modelType)=="spec") { - output$fitProgressOutput <- renderPrint({ - rvs$specModel <- initModel(mod_type = "spec", specpar = specvec, nupow=1) - - rvs$specFit <- fitModel(data=list(isolate(rvs$simData)), modspec=list(isolate(rvs$specModel)),opt=kinopt(iter=iters, plot=FALSE)) - - rvs$specFitSummary <- summary(isolate(rvs$specFit)$currModel@fit@nlsres[[1]], - currModel=isolate(rvs$specFit)$currModel, - currTheta=isolate(rvs$specFit)$currTheta, - correlation=TRUE) - updateConsole(isolate(rvs$modelType)) - updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr)) - }) - # Currently the kin and spectemp models are treated the same - } else if(isolate(rvs$modelType) == "spectemp") { - output$fitProgressOutput <- renderPrint({ - rvs$spectempModel <- initModel(mod_type = "kin", kinpar = kinpar, irf = irf, - irfpar = if(irf) irfpar else vector(), - streak = streak, - streakT = 13164.8235, - positivepar = positivepar, - seqmod=seqmod) - isolate({ - rvs$spectempModel@specpar <- isolate(specvec) - rvs$spectempFit<-spectemp(isolate(rvs$simData), isolate(rvs$spectempModel), iter=iters, kroncol = kroncol, lin=linr,l_posk=positivepar) - rvs$spectempFitSummary <- summary(isolate(rvs$spectempFit$onls)) - rvs$spectempFitTheta <- isolate(rvs$spectempFit$theta) - updateConsole(isolate(rvs$modelType)) - - updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$spectempModel), isolate(rvs$spectempFit$onls), isolate(rvs$spectempFitTheta), linr = isolate(linr)) - }) - - }) - - + withProgress( + { + ## This works with a function like message + ## withCallingHandlers({ + ## shinyjs::html("fitProgressOutput","") + ## + + updateTabsetPanel(session, "outputTabs", selected = "Fit progression") + + kinpar <- as.double(strsplit(isolate(input$fitDecayRates), ",")[[1]]) + spec_loc <- strsplit(isolate(input$fitSpecLoc), ",")[[1]] + spec_wid <- strsplit(isolate(input$fitSpecWidth), ",")[[1]] + spec_b <- strsplit(isolate(input$fitSpecSkew), ",")[[1]] + specvec <- newSpecList(spec_loc, spec_wid, spec_b) + kroncol <- input$fitKroncol + irf <- input$fitEnableIRF + irfloc <- as.double(isolate(input$fitLocIRF)) + irfwidth <- as.double(isolate(input$fitWidthIRF)) + irfpar <- c(irfloc, irfwidth) + seqmod <- input$fitSeqmod + positivepar <- input$fitPosDec + streak <- input$fitEnableStreak + rvs$modelType <- input$modelType + linAxis <- isolate(input$fitLinAxis) + linr <- if (is.na(linAxis)) { + NA } else { - setProgress(value = 0, message = "failed.") - print("model not implemented", file=stderr()) + if (linAxis < 0.1) { + NA + } else { + linAxis + } } + iters <- isolate(input$fitNumIters) + + isolate({ + if ((isolate(rvs$modelType) == "kin")) { + output$fitProgressOutput <- renderPrint({ + rvs$kinModel <- initModel( + mod_type = "kin", kinpar = kinpar, irf = irf, + irfpar = if (irf) irfpar else vector(), + streak = streak, + streakT = 13164.8235, + positivepar = if (positivepar) c("kinpar") else vector(), + seqmod = seqmod + ) + + rvs$kinFit <- fitModel(data = list(isolate(rvs$simData)), modspec = list(isolate(rvs$kinModel)), opt = kinopt(iter = iters, plot = FALSE)) + rvs$kinFitSummary <- summary(isolate(rvs$kinFit)$currModel@fit@nlsres[[1]], + currModel = isolate(rvs$kinFit)$currModel, + currTheta = isolate(rvs$kinFit)$currTheta, + correlation = TRUE + ) + updateConsole(isolate(rvs$modelType)) + updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr)) + }) + } else if (isolate(rvs$modelType) == "spec") { + output$fitProgressOutput <- renderPrint({ + rvs$specModel <- initModel(mod_type = "spec", specpar = specvec, nupow = 1) + rvs$specFit <- fitModel(data = list(isolate(rvs$simData)), modspec = list(isolate(rvs$specModel)), opt = kinopt(iter = iters, plot = FALSE)) - }) ## end of isolate - - }, message ="fitting data ...") ## end of withProgress - } - ) + rvs$specFitSummary <- summary(isolate(rvs$specFit)$currModel@fit@nlsres[[1]], + currModel = isolate(rvs$specFit)$currModel, + currTheta = isolate(rvs$specFit)$currTheta, + correlation = TRUE + ) + updateConsole(isolate(rvs$modelType)) + updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr)) + }) + # Currently the kin and spectemp models are treated the same + } else if (isolate(rvs$modelType) == "spectemp") { + output$fitProgressOutput <- renderPrint({ + rvs$spectempModel <- initModel( + mod_type = "kin", kinpar = kinpar, irf = irf, + irfpar = if (irf) irfpar else vector(), + streak = streak, + streakT = 13164.8235, + positivepar = positivepar, + seqmod = seqmod + ) + isolate({ + rvs$spectempModel@specpar <- isolate(specvec) + rvs$spectempFit <- spectemp(isolate(rvs$simData), isolate(rvs$spectempModel), iter = iters, kroncol = kroncol, lin = linr, l_posk = positivepar) + rvs$spectempFitSummary <- summary(isolate(rvs$spectempFit$onls)) + rvs$spectempFitTheta <- isolate(rvs$spectempFit$theta) + updateConsole(isolate(rvs$modelType)) + + updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$spectempModel), isolate(rvs$spectempFit$onls), isolate(rvs$spectempFitTheta), linr = isolate(linr)) + }) + }) + } else { + setProgress(value = 0, message = "failed.") + print("model not implemented", file = stderr()) + } + }) ## end of isolate + }, + message = "fitting data ..." + ) ## end of withProgress + }) observeEvent(input$saveDataButton, { - tryFilename <- paste(isolate(input$simFilename),"-",format(Sys.time(), "%Y%m%d_%H%M"),".rds",sep="") - tryFullFilename <- file.path(path.expand("~"),tryFilename) - #saveRDS(isolate(rvs$simData), tryFullFilename) + tryFilename <- paste(isolate(input$simFilename), "-", format(Sys.time(), "%Y%m%d_%H%M"), ".rds", sep = "") + tryFullFilename <- file.path(path.expand("~"), tryFilename) + # saveRDS(isolate(rvs$simData), tryFullFilename) sim <- isolate(rvs$simData) - save(sim, file=tryFullFilename) - cat("File was saved to:\n",tryFullFilename,"\n",file=stdout()) - - } - ) + save(sim, file = tryFullFilename) + cat("File was saved to:\n", tryFullFilename, "\n", file = stdout()) + }) observeEvent(input$updateModelButton, { # # fitDecayRates, fitLocIRF, fitWidthIRF isolate({ - if(rvs$modelType=="kin" && !is.null(isolate(rvs$kinFit))) { - updateTextInput(session, "fitDecayRates", value = toString(signif(rvs$kinFit$currTheta[[1]]@kinpar,digits=4))) - if(length(rvs$kinFit$currTheta[[1]]@irfpar)>0) { - updateTextInput(session, "fitLocIRF", value = toString(signif(rvs$kinFit$currTheta[[1]]@irfpar[[1]],digits=4))) - updateTextInput(session, "fitWidthIRF", value = toString(signif(rvs$kinFit$currTheta[[1]]@irfpar[[2]],digits=4))) + if (rvs$modelType == "kin" && !is.null(isolate(rvs$kinFit))) { + updateTextInput(session, "fitDecayRates", value = toString(signif(rvs$kinFit$currTheta[[1]]@kinpar, digits = 4))) + if (length(rvs$kinFit$currTheta[[1]]@irfpar) > 0) { + updateTextInput(session, "fitLocIRF", value = toString(signif(rvs$kinFit$currTheta[[1]]@irfpar[[1]], digits = 4))) + updateTextInput(session, "fitWidthIRF", value = toString(signif(rvs$kinFit$currTheta[[1]]@irfpar[[2]], digits = 4))) } # updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr)) } # # fitSpecLoc fitSpecWidth fitSpecSkew - if(rvs$modelType=="spec" && !is.null(isolate(rvs$specFit))) { - nsc <- length(rvs$specFit$currTheta[[1]]@specpar) #numberOfSpectralComponents - if(nsc>0) { - spectralParameterVector <- do.call(c,rvs$specFit$currTheta[[1]]@specpar) - updateTextInput(session, "fitSpecLoc", value = toString(signif(spectralParameterVector[seq(1,3*nsc,3)],digits=4))) - updateTextInput(session, "fitSpecWidth", value = toString(signif(spectralParameterVector[seq(2,3*nsc,3)],digits=4))) - updateTextInput(session, "fitSpecSkew", value = toString(signif(spectralParameterVector[seq(3,3*nsc,3)],digits=4))) + if (rvs$modelType == "spec" && !is.null(isolate(rvs$specFit))) { + nsc <- length(rvs$specFit$currTheta[[1]]@specpar) # numberOfSpectralComponents + if (nsc > 0) { + spectralParameterVector <- do.call(c, rvs$specFit$currTheta[[1]]@specpar) + updateTextInput(session, "fitSpecLoc", value = toString(signif(spectralParameterVector[seq(1, 3 * nsc, 3)], digits = 4))) + updateTextInput(session, "fitSpecWidth", value = toString(signif(spectralParameterVector[seq(2, 3 * nsc, 3)], digits = 4))) + updateTextInput(session, "fitSpecSkew", value = toString(signif(spectralParameterVector[seq(3, 3 * nsc, 3)], digits = 4))) } # updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr)) - } - if(rvs$modelType=="spectemp" && !is.null(isolate(rvs$spectempFit))) { - updateTextInput(session, "fitDecayRates", value = toString(signif(rvs$spectempFit[[1]]@kinpar,digits=4))) - if(length(rvs$spectempFit[[1]]@irfpar)>0) { - updateTextInput(session, "fitLocIRF", value = toString(signif(rvs$spectempFit[[1]]@irfpar[[1]],digits=4))) - updateTextInput(session, "fitWidthIRF", value = toString(signif(rvs$spectempFit[[1]]@irfpar[[2]],digits=4))) + if (rvs$modelType == "spectemp" && !is.null(isolate(rvs$spectempFit))) { + updateTextInput(session, "fitDecayRates", value = toString(signif(rvs$spectempFit[[1]]@kinpar, digits = 4))) + if (length(rvs$spectempFit[[1]]@irfpar) > 0) { + updateTextInput(session, "fitLocIRF", value = toString(signif(rvs$spectempFit[[1]]@irfpar[[1]], digits = 4))) + updateTextInput(session, "fitWidthIRF", value = toString(signif(rvs$spectempFit[[1]]@irfpar[[2]], digits = 4))) } - nsc <- (length(rvs$spectempFit[[1]]@specpar[[1]])/3) #numberOfSpectralComponents - if(nsc>0) { + nsc <- (length(rvs$spectempFit[[1]]@specpar[[1]]) / 3) # numberOfSpectralComponents + if (nsc > 0) { spectralParameterVector <- rvs$spectempFit[[1]]@specpar[[1]] - updateTextInput(session, "fitSpecLoc", value = toString(signif(spectralParameterVector[seq(1,3*nsc,3)],digits=4))) - updateTextInput(session, "fitSpecWidth", value = toString(signif(spectralParameterVector[seq(2,3*nsc,3)],digits=4))) - updateTextInput(session, "fitSpecSkew", value = toString(signif(spectralParameterVector[seq(3,3*nsc,3)],digits=4))) + updateTextInput(session, "fitSpecLoc", value = toString(signif(spectralParameterVector[seq(1, 3 * nsc, 3)], digits = 4))) + updateTextInput(session, "fitSpecWidth", value = toString(signif(spectralParameterVector[seq(2, 3 * nsc, 3)], digits = 4))) + updateTextInput(session, "fitSpecSkew", value = toString(signif(spectralParameterVector[seq(3, 3 * nsc, 3)], digits = 4))) } } }) - } - ) + }) observeEvent(input$printSummaryButton, { resultToPrint <- switch(input$modelType, - kin=rvs$kinFitSummary, - spec=rvs$specFitSummary, - spectemp=rvs$spectempFitSummary + kin = rvs$kinFitSummary, + spec = rvs$specFitSummary, + spectemp = rvs$spectempFitSummary ) print(resultToPrint, - file=stdout()) - } - ) + file = stdout() + ) + }) - updatePlots <- function(modType="kin", data, model=NULL, result=NULL, theta=NULL, linr = NA) { - output$fitPlot <- renderPlot({ - plotterforGUI(modtype=modType, data=data, model=model, result=result, theta=theta, lin = linr, guessIRF = isolate(rvs$guessIRF)) - },res = 96) + updatePlots <- function(modType = "kin", data, model = NULL, result = NULL, theta = NULL, linr = NA) { + output$fitPlot <- renderPlot( + { + plotterforGUI(modtype = modType, data = data, model = model, result = result, theta = theta, lin = linr, guessIRF = isolate(rvs$guessIRF)) + }, + res = 96 + ) } updateDataPlot <- function(irfloc, linr) { # Plot the simulated data, and render it to the dataPlot field in output. - output$dataPlot <- renderPlot({ - plotterforGUI(modtype="kin", data=isolate(rvs$simData), model=NULL, result=NULL,mu=irfloc,lin=linr,guessIRF = isolate(rvs$guessIRF)) - },res = 96) + output$dataPlot <- renderPlot( + { + plotterforGUI(modtype = "kin", data = isolate(rvs$simData), model = NULL, result = NULL, mu = irfloc, lin = linr, guessIRF = isolate(rvs$guessIRF)) + }, + res = 96 + ) } - plotMessage <- function(plotmsg = "An arror occured",msgcolor = "black") { - par(mar = c(0,0,0,0)) - plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n') - usr <- par( "usr" ) - text(x = usr[1], y = usr[4], paste(plotmsg), adj = c( 0, 1), - cex = 1.6, col = msgcolor) + plotMessage <- function(plotmsg = "An arror occured", msgcolor = "black") { + par(mar = c(0, 0, 0, 0)) + plot(c(0, 1), c(0, 1), ann = F, bty = "n", type = "n", xaxt = "n", yaxt = "n") + usr <- par("usr") + text( + x = usr[1], y = usr[4], paste(plotmsg), adj = c(0, 1), + cex = 1.6, col = msgcolor + ) } updateConsole <- function(modelType) { resultToPrint <- switch(modelType, - kin=isolate(rvs$kinFitSummary), - spec=isolate(rvs$specFitSummary), - spectemp=isolate(rvs$spectempFitSummary) + kin = isolate(rvs$kinFitSummary), + spec = isolate(rvs$specFitSummary), + spectemp = isolate(rvs$spectempFitSummary) ) - output$consoleOutput <- renderPrint({print(resultToPrint,width=100)}) + output$consoleOutput <- renderPrint({ + print(resultToPrint, width = 100) + }) } observe({ linAxis <- input$fitLinAxis - linr <- if(is.na(linAxis)) {NA} else {if(linAxis<0.1) {NA} else {linAxis}} + linr <- if (is.na(linAxis)) { + NA + } else { + if (linAxis < 0.1) { + NA + } else { + linAxis + } + } irfloc <- 0 # as.double(isolate(input$simLocIRF)) - if(!is.null(isolate(rvs$simData))) { + if (!is.null(isolate(rvs$simData))) { updateDataPlot(irfloc, linr) } # updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr)) - if(!is.null(isolate(rvs$simData))) { - if(rvs$modelType=="kin" && !is.null(isolate(rvs$kinFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr)) - if(rvs$modelType=="spec" && !is.null(isolate(rvs$specFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr)) - if(rvs$modelType=="spectemp" && !is.null(isolate(rvs$spectempFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$spectempModel), isolate(rvs$spectempFit$onls), isolate(rvs$spectempFitTheta), linr = isolate(linr)) - + if (!is.null(isolate(rvs$simData))) { + if (rvs$modelType == "kin" && !is.null(isolate(rvs$kinFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr)) + if (rvs$modelType == "spec" && !is.null(isolate(rvs$specFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr)) + if (rvs$modelType == "spectemp" && !is.null(isolate(rvs$spectempFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$spectempModel), isolate(rvs$spectempFit$onls), isolate(rvs$spectempFitTheta), linr = isolate(linr)) } }) observe({ infile <- input$loadData - if(is.null(infile)) { + if (is.null(infile)) { return(NULL) } else { - if(paramGUI::is_rdata(infile$datapath)) { + if (paramGUI::is_rdata(infile$datapath)) { load(infile$datapath) rvs$simData <- sim # assign(".sim", sim,globalenv()) } else { # First check if the file is readable by TIMP testHeader <- scan(file = infile$datapath, skip = 2, nlines = 2, what = " ") - matchedKeywords <- length(grep(paste(c("Time","Wavelength","explicit","Intervalnr"),collapse="|"),testHeader,ignore.case=TRUE,value=TRUE)) - if(matchedKeywords>2) { + matchedKeywords <- length(grep(paste(c("Time", "Wavelength", "explicit", "Intervalnr"), collapse = "|"), testHeader, ignore.case = TRUE, value = TRUE)) + if (matchedKeywords > 2) { rvs$simData <- TIMP::readData(infile$datapath) } else { - print("# Unable to load data.\n",file=stderr()) + print("# Unable to load data.\n", file = stderr()) } } - updateTabsetPanel(session,"outputTabs",selected="Data" ) - output$dataPlot <- renderPlot({ - plotterforGUI(modtype="kin", data=isolate(rvs$simData), model=NULL, result=NULL,mu=0) - },res = 96) - + updateTabsetPanel(session, "outputTabs", selected = "Data") + output$dataPlot <- renderPlot( + { + plotterforGUI(modtype = "kin", data = isolate(rvs$simData), model = NULL, result = NULL, mu = 0) + }, + res = 96 + ) } }) @@ -609,39 +672,43 @@ server <- function(input, output, session) { }) loadDefaultData <- function() { - print("\nLoading data representing the peridinin chlorophyll protein (PCP) excited with 490 nm laser light...\n",file=stdout()) - rvs$simData <- dat(psi.df = datamat, x2 = waves, x = times, - nt = length(times), nl = length(waves), simdata = FALSE) - updateTabsetPanel(session,"outputTabs",selected="Data" ) - output$dataPlot <- renderPlot({ - plotterforGUI(modtype="kin", data=isolate(rvs$simData), model=NULL, result=NULL,mu=0,lin=1) - },res = 96) + print("\nLoading data representing the peridinin chlorophyll protein (PCP) excited with 490 nm laser light...\n", file = stdout()) + rvs$simData <- dat( + psi.df = datamat, x2 = waves, x = times, + nt = length(times), nl = length(waves), simdata = FALSE + ) + updateTabsetPanel(session, "outputTabs", selected = "Data") + output$dataPlot <- renderPlot( + { + plotterforGUI(modtype = "kin", data = isolate(rvs$simData), model = NULL, result = NULL, mu = 0, lin = 1) + }, + res = 96 + ) } # Function that listens to key presses observe({ - if(!is.null(input$keyPressed)) { + if (!is.null(input$keyPressed)) { # 4 # CTRL+SHIFT+D # Toggle debug # 9 # CTRL+SHIFT+I # Toggle simulation object info # 19 # CTRL+SHIFT+S # Something with save - if(isolate(rvs$DEBUG)) { - cat("You pressed: ",input$keyPressed[[1]],"\n",file=stderr()) + if (isolate(rvs$DEBUG)) { + cat("You pressed: ", input$keyPressed[[1]], "\n", file = stderr()) } - if(input$keyPressed[[1]]==192) { # 192 #ctrl+~ - if(isolate(rvs$DEBUG)) cat("Toggled guessIRF to: ", !isolate(rvs$guessIRF),"\n") + if (input$keyPressed[[1]] == 192) { # 192 #ctrl+~ + if (isolate(rvs$DEBUG)) cat("Toggled guessIRF to: ", !isolate(rvs$guessIRF), "\n") rvs$guessIRF <- !isolate(rvs$guessIRF) } - if(input$keyPressed[[1]]==9){ - if(isolate(rvs$DEBUG)) cat("Toggled nosiminfo to: ", !isolate(rvs$nosiminfo),"\n") + if (input$keyPressed[[1]] == 9) { + if (isolate(rvs$DEBUG)) cat("Toggled nosiminfo to: ", !isolate(rvs$nosiminfo), "\n") rvs$nosiminfo <- !isolate(rvs$nosiminfo) } - if(input$keyPressed[[1]]==4){ - cat("Toggled DEBUG to: ", !isolate(rvs$DEBUG),"\n") + if (input$keyPressed[[1]] == 4) { + cat("Toggled DEBUG to: ", !isolate(rvs$DEBUG), "\n") rvs$DEBUG <- !isolate(rvs$DEBUG) } } }) - } shinyApp(ui, server) From de5cd5a6f1a4f0e3c3693cd25eb0097006ea8055 Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:39:17 +0100 Subject: [PATCH 06/10] =?UTF-8?q?=F0=9F=93=9A=20Fix=20spelling=20errors=20?= =?UTF-8?q?and=20address=20issues=20in=20docs?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/example_dataset.R | 2 +- R/paramGUI-package.R | 2 ++ R/paramGUI.R | 2 +- R/utility.R | 2 +- man/example_dataset.Rd | 4 ++-- man/is_compressed.Rd | 2 +- man/linlogtics.Rd | 2 +- man/paramGUI.Rd | 4 ++++ man/runGUI.Rd | 1 - man/spectemp.Rd | 3 ++- 10 files changed, 15 insertions(+), 9 deletions(-) diff --git a/R/example_dataset.R b/R/example_dataset.R index 594662e..1926b2e 100644 --- a/R/example_dataset.R +++ b/R/example_dataset.R @@ -6,7 +6,7 @@ #' @author Ivo van Stokkum \email{i.h.m.van.stokkum@vu.nl} #' @references \doi{10.1016/j.chemphys.2008.10.005} #' @keywords data -#' @description Dispersion corrected time-resolved transient-absoprtion data +#' @description Dispersion corrected time-resolved transient-absorption data #' of the peridinin chlorophyll protein (PCP) excited with 490 nm laser light #' from the publication of Stokkum et.al. (2009) NULL diff --git a/R/paramGUI-package.R b/R/paramGUI-package.R index af0a4a6..94c50ed 100644 --- a/R/paramGUI-package.R +++ b/R/paramGUI-package.R @@ -1,6 +1,8 @@ #' paramGUI #' #' @name paramGUI +#' @description Allows specification and fitting of some parameter estimation +#' examples inspired by time-resolved spectroscopy via a Shiny GUI. #' @docType package #' @import shiny shinydashboard #' @importFrom TIMP initModel fitModel diff --git a/R/paramGUI.R b/R/paramGUI.R index cfb43b2..60bed42 100755 --- a/R/paramGUI.R +++ b/R/paramGUI.R @@ -165,7 +165,7 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, #' Generate linlog tics for a linear-logarithmic axis #' #' @param x values for which to calculate a linlog axis -#' @param mu center of axis in the orginal \code{x} axis +#' @param mu center of axis in the original \code{x} axis #' @param alpha linear part #' #' @return Returns matrix with new \code{x} values in first column and the corresponding labels in the second column. diff --git a/R/utility.R b/R/utility.R index c39ccbe..97750a5 100644 --- a/R/utility.R +++ b/R/utility.R @@ -12,7 +12,7 @@ #' @description Helper function for is_rdata, checks if the file is a compressed (gzip) file. Does not (yet) check for bzip2 or xz compression. #' #' @param filename The filename of the file to test for magic compression codes -#' @param magic.number The magic numbers in as a vector of strings with the hexidecimal numbers (e.g. "0x1f") +#' @param magic.number The magic numbers in as a vector of strings with the hexadecimal numbers (e.g. "0x1f") #' #' @return boolean, TRUE if the file is compressed #' diff --git a/man/example_dataset.Rd b/man/example_dataset.Rd index f606b69..9aa41b5 100644 --- a/man/example_dataset.Rd +++ b/man/example_dataset.Rd @@ -6,9 +6,9 @@ \alias{datamat} \alias{times} \alias{waves} -\title{This is data to be included in my package} +\title{This is an example dataset included in this package} \description{ -Dispersion corrected time-resolved transient-absoprtion data +Dispersion corrected time-resolved transient-absorption data of the peridinin chlorophyll protein (PCP) excited with 490 nm laser light from the publication of Stokkum et.al. (2009) } diff --git a/man/is_compressed.Rd b/man/is_compressed.Rd index 78807a4..2cbca4a 100644 --- a/man/is_compressed.Rd +++ b/man/is_compressed.Rd @@ -9,7 +9,7 @@ is_compressed(filename, magic.number = as.raw(c("0x1f", "0x8b"))) \arguments{ \item{filename}{The filename of the file to test for magic compression codes} -\item{magic.number}{The magic numbers in as a vector of strings with the hexidecimal numbers (e.g. "0x1f")} +\item{magic.number}{The magic numbers in as a vector of strings with the hexadecimal numbers (e.g. "0x1f")} } \value{ boolean, TRUE if the file is compressed diff --git a/man/linlogtics.Rd b/man/linlogtics.Rd index 16daf8a..daa2348 100644 --- a/man/linlogtics.Rd +++ b/man/linlogtics.Rd @@ -9,7 +9,7 @@ linlogtics(x, mu, alpha) \arguments{ \item{x}{values for which to calculate a linlog axis} -\item{mu}{center of axis in the orginal \code{x} axis} +\item{mu}{center of axis in the original \code{x} axis} \item{alpha}{linear part} } diff --git a/man/paramGUI.Rd b/man/paramGUI.Rd index e6bfa61..12f557f 100755 --- a/man/paramGUI.Rd +++ b/man/paramGUI.Rd @@ -4,3 +4,7 @@ \name{paramGUI} \alias{paramGUI} \title{paramGUI} +\description{ +Allows specification and fitting of some parameter estimation +examples inspired by time-resolved spectroscopy via a Shiny GUI. +} diff --git a/man/runGUI.Rd b/man/runGUI.Rd index 5e3d719..72ef7bc 100644 --- a/man/runGUI.Rd +++ b/man/runGUI.Rd @@ -14,7 +14,6 @@ Runs the shiny paramGUI app. runGUI() } - } \keyword{GUI} \keyword{shiny} diff --git a/man/spectemp.Rd b/man/spectemp.Rd index 44fae08..7038c41 100644 --- a/man/spectemp.Rd +++ b/man/spectemp.Rd @@ -19,7 +19,8 @@ spectemp(sim, model, iter, kroncol = FALSE, lin = NA, l_posk = FALSE) \item{lin}{defines the range to plot linearly (from -\code{lin} to +\code{lin})} -\item{l_posk}{object of class \code{logical} indicating whether positivity constraints are enforced on the rate parameters} +\item{l_posk}{object of class \code{logical} indicating whether +positivity constraints are enforced on the rate parameters} } \description{ Spectrotemporal model From 97f42c0ded9bddc3a68f1121afa132b947f5040c Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:52:36 +0100 Subject: [PATCH 07/10] =?UTF-8?q?=F0=9F=A7=B9More=20tidying=20up=20of=20fo?= =?UTF-8?q?rmatting?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also ran `usethis::use_tidy_description()` --- DESCRIPTION | 25 ++++++++++++------------- R/paramGUI.R | 27 +++++++++++++++++---------- R/runApp.R | 3 ++- R/utility.R | 18 +++++++++++------- man/calcE.Rd | 3 ++- man/kroneckercol.Rd | 3 ++- man/linlogtics.Rd | 3 ++- man/plotterforGUI.Rd | 3 ++- man/spectemp.Rd | 9 +++++---- 9 files changed, 55 insertions(+), 39 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2087cb..94e9a24 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,23 +1,22 @@ Package: paramGUI Title: A Shiny GUI for some Parameter Estimation Examples Version: 2.1.4 -Authors@R: c(person("Joris", "Snellenburg", role = c("cre","aut"), - email = "j.snellenburg@vu.nl"), - person("Katharine", "Mullen", role = "aut"), - person("Ivo", "van Stokkum", role = "aut", - email = "ivo@few.vu.nl")) -Description: Allows specification and fitting of some parameter - estimation examples inspired by time-resolved spectroscopy via - a Shiny GUI. +Authors@R: c( + person("Joris", "Snellenburg", , "j.snellenburg@vu.nl", role = c("cre", "aut")), + person("Katharine", "Mullen", role = "aut"), + person("Ivo", "van Stokkum", , "ivo@few.vu.nl", role = "aut") + ) +Description: Allows specification and fitting of some parameter estimation + examples inspired by time-resolved spectroscopy via a Shiny GUI. +License: GPL (>= 2) Depends: + colorspace, + fields, R (>= 3.0.0), - TIMP, shiny, shinydashboard, - colorspace, - fields -License: GPL (>= 2) + TIMP Encoding: UTF-8 +Language: en-US LazyData: true RoxygenNote: 7.2.3 -Language: en-US diff --git a/R/paramGUI.R b/R/paramGUI.R index 60bed42..270bf87 100755 --- a/R/paramGUI.R +++ b/R/paramGUI.R @@ -1,7 +1,8 @@ #' Calculates a matrix in which each column is a skewed Gaussian #' #' @description Calculates a matrix in which each column is a skewed Gaussian. -#' Like \code{calcEhiergaus} from TIMP package but uses a vector not a list of parameter estimates. +#' Like \code{calcEhiergaus} from TIMP package but uses a vector not a list of +#' parameter estimates. #' #' @param theta vector of parameter estimates #' @param lambda wavelengths at which to calculate model @@ -29,11 +30,12 @@ calcE <- function(theta, lambda) { #' @param model object of class \code{dat} representing a model #' @param iter integer number of iterations #' @param kroncol object of class \code{logical} that is -#' \code{TRUE} if the \code{kroneckcol} function should be used to formulate the model and -#' \code{FALSE} if the standard \code{kronecker} is to be used instead -#' @param lin defines the range to plot linearly (from -\code{lin} to +\code{lin}) +#' \code{TRUE} if the \code{kroneckcol} function should be used to formulate the +#' model and \code{FALSE} if the standard \code{kronecker} is to be used instead +#' @param lin defines the range to plot linearly +#' (from -\code{lin} to +\code{lin}) #' @param l_posk object of class \code{logical} indicating whether -#' positivity constraints are enforced on the rate parameters +#' positivity-constraints are enforced on the rate parameters #' #' @importFrom TIMP compModel #' @importFrom stats nls nls.control @@ -143,7 +145,8 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, #' kroneckercol: column-wise kronecker product #' -#' @description The column-wise kronecker product is also called the Khatri–Rao product +#' @description The column-wise kronecker product is also called +#' the Khatri–Rao product #' #' @param A numerical matrix #' @param B numerical matrix @@ -168,7 +171,8 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, #' @param mu center of axis in the original \code{x} axis #' @param alpha linear part #' -#' @return Returns matrix with new \code{x} values in first column and the corresponding labels in the second column. +#' @return Returns matrix with new \code{x} values in first column and the +#' corresponding labels in the second column. #' "linlogtics" <- function(x, mu, alpha) { maxorigx <- max(x) @@ -207,13 +211,16 @@ spectemp <- function(sim, model, iter, kroncol = FALSE, lin = NA, #' \code{modtype=='spectemp'}, by \code{nls} #' @param lin The linear range for the concentration plot #' @param mu The center of the lin-log axis is \code{lin} is specified -#' @param guessIRF Boolean to indicate whether to try and guess the location of the IRF +#' @param guessIRF Boolean to indicate whether to try and guess the +#' location of the IRF #' #' @return graphics #' @importFrom fields image.plot #' @importFrom colorspace diverge_hcl -#' @importFrom TIMP compModel getSpecList parEst linloglines linlogplot irfparF matlinlogplot -#' @importFrom graphics abline axis barplot image lines matlines matplot mtext par plot +#' @importFrom TIMP compModel getSpecList parEst linloglines linlogplot +#' @importFrom TIMP irfparF matlinlogplot +#' @importFrom graphics abline axis barplot image lines matlines matplot +#' @importFrom graphics mtext par plot #' @importFrom stats dnorm #' @export #' diff --git a/R/runApp.R b/R/runApp.R index dc9758d..495838b 100644 --- a/R/runApp.R +++ b/R/runApp.R @@ -12,7 +12,8 @@ runGUI <- function() { appDir <- system.file("shinyApps", "paramGUI", package = "paramGUI") if (appDir == "") { - stop("Could not find example directory. Try re-installing `paramGUI`.", call. = FALSE) + stop("Could not find example directory. + Try re-installing `paramGUI`.", call. = FALSE) } shiny::runApp(appDir, display.mode = "normal") diff --git a/R/utility.R b/R/utility.R index 97750a5..5c6f07a 100644 --- a/R/utility.R +++ b/R/utility.R @@ -1,18 +1,22 @@ -## The two functions in R Script file were found in one of the answers to this question on stackoverflow.com: -## http://stackoverflow.com/questions/30127019/check-whether-file-is-binary -## The functions were written by the stackoverflow user MrFlick, a direct link to his answer is here: -## http://stackoverflow.com/a/30128809/3020822 +## The two functions in R Script file were found in one of the answers to +## this question on stackoverflow: +## https://stackoverflow.com/q/30127019 +## The functions were written by the stackoverflow user MrFlick, +## a direct link to his answer is here: +## https://stackoverflow.com/a/30128809 ## This answer was provided on May 8th 2015, which means as can be read here: -## http://meta.stackexchange.com/questions/271080/the-mit-license-clarity-on-using-code-on-stack-overflow-and-stack-exchange +## https://meta.stackexchange.com/q/271080 ## the code falls under the CC-BY-SA license available here: ## https://creativecommons.org/licenses/by-sa/3.0/ #' is_compressed #' -#' @description Helper function for is_rdata, checks if the file is a compressed (gzip) file. Does not (yet) check for bzip2 or xz compression. +#' @description Helper function for is_rdata, checks if the file is a +#' compressed (gzip) file. Does not (yet) check for bzip2 or xz compression. #' #' @param filename The filename of the file to test for magic compression codes -#' @param magic.number The magic numbers in as a vector of strings with the hexadecimal numbers (e.g. "0x1f") +#' @param magic.number The magic numbers in as a vector of strings +#' with the hexadecimal numbers (e.g. "0x1f") #' #' @return boolean, TRUE if the file is compressed #' diff --git a/man/calcE.Rd b/man/calcE.Rd index 758b014..0c2d74d 100644 --- a/man/calcE.Rd +++ b/man/calcE.Rd @@ -16,5 +16,6 @@ calcE(theta, lambda) } \description{ Calculates a matrix in which each column is a skewed Gaussian. -Like \code{calcEhiergaus} from TIMP package but uses a vector not a list of parameter estimates. +Like \code{calcEhiergaus} from TIMP package but uses a vector not a list of +parameter estimates. } diff --git a/man/kroneckercol.Rd b/man/kroneckercol.Rd index 672d793..d8e4842 100644 --- a/man/kroneckercol.Rd +++ b/man/kroneckercol.Rd @@ -15,5 +15,6 @@ kroneckercol(A, B) column-wise kronecker product of A and B } \description{ -The column-wise kronecker product is also called the Khatri–Rao product +The column-wise kronecker product is also called +the Khatri–Rao product } diff --git a/man/linlogtics.Rd b/man/linlogtics.Rd index daa2348..c1f9d3e 100644 --- a/man/linlogtics.Rd +++ b/man/linlogtics.Rd @@ -14,7 +14,8 @@ linlogtics(x, mu, alpha) \item{alpha}{linear part} } \value{ -Returns matrix with new \code{x} values in first column and the corresponding labels in the second column. +Returns matrix with new \code{x} values in first column and the +corresponding labels in the second column. } \description{ Generate linlog tics for a linear-logarithmic axis diff --git a/man/plotterforGUI.Rd b/man/plotterforGUI.Rd index cd31995..95cd93a 100644 --- a/man/plotterforGUI.Rd +++ b/man/plotterforGUI.Rd @@ -34,7 +34,8 @@ plotterforGUI( \item{mu}{The center of the lin-log axis is \code{lin} is specified} -\item{guessIRF}{Boolean to indicate whether to try and guess the location of the IRF} +\item{guessIRF}{Boolean to indicate whether to try and guess the +location of the IRF} } \value{ graphics diff --git a/man/spectemp.Rd b/man/spectemp.Rd index 7038c41..2325b09 100644 --- a/man/spectemp.Rd +++ b/man/spectemp.Rd @@ -14,13 +14,14 @@ spectemp(sim, model, iter, kroncol = FALSE, lin = NA, l_posk = FALSE) \item{iter}{integer number of iterations} \item{kroncol}{object of class \code{logical} that is -\code{TRUE} if the \code{kroneckcol} function should be used to formulate the model and -\code{FALSE} if the standard \code{kronecker} is to be used instead} +\code{TRUE} if the \code{kroneckcol} function should be used to formulate the +model and \code{FALSE} if the standard \code{kronecker} is to be used instead} -\item{lin}{defines the range to plot linearly (from -\code{lin} to +\code{lin})} +\item{lin}{defines the range to plot linearly +(from -\code{lin} to +\code{lin})} \item{l_posk}{object of class \code{logical} indicating whether -positivity constraints are enforced on the rate parameters} +positivity-constraints are enforced on the rate parameters} } \description{ Spectrotemporal model From b49d4b454adc1685192eb8c16665d3396d593e1c Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:52:56 +0100 Subject: [PATCH 08/10] Update version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 94e9a24..abc882e 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: paramGUI Title: A Shiny GUI for some Parameter Estimation Examples -Version: 2.1.4 +Version: 2.1.5 Authors@R: c( person("Joris", "Snellenburg", , "j.snellenburg@vu.nl", role = c("cre", "aut")), person("Katharine", "Mullen", role = "aut"), From 761c8c9c6b7a23ac864ac556c815f47c4b6d2f7a Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Fri, 23 Dec 2022 23:58:48 +0100 Subject: [PATCH 09/10] More formatting --- man/is_compressed.Rd | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/man/is_compressed.Rd b/man/is_compressed.Rd index 2cbca4a..60f3f47 100644 --- a/man/is_compressed.Rd +++ b/man/is_compressed.Rd @@ -9,11 +9,13 @@ is_compressed(filename, magic.number = as.raw(c("0x1f", "0x8b"))) \arguments{ \item{filename}{The filename of the file to test for magic compression codes} -\item{magic.number}{The magic numbers in as a vector of strings with the hexadecimal numbers (e.g. "0x1f")} +\item{magic.number}{The magic numbers in as a vector of strings +with the hexadecimal numbers (e.g. "0x1f")} } \value{ boolean, TRUE if the file is compressed } \description{ -Helper function for is_rdata, checks if the file is a compressed (gzip) file. Does not (yet) check for bzip2 or xz compression. +Helper function for is_rdata, checks if the file is a +compressed (gzip) file. Does not (yet) check for bzip2 or xz compression. } From 3fd12d7c0a23161b32ae59ef63233824db74004d Mon Sep 17 00:00:00 2001 From: Joris Snellenburg Date: Sat, 24 Dec 2022 00:04:02 +0100 Subject: [PATCH 10/10] Update gitignore Ran `inteRgrate::check_gitignore()` --- .gitignore | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 886732b..6d8b045 100644 --- a/.gitignore +++ b/.gitignore @@ -2,8 +2,10 @@ .Rhistory .Rapp.history -# Session Data files +# Session and environemnt Data files .RData +.Ruserdata +.Renviron # Example code in package build process *-Ex.R @@ -27,8 +29,12 @@ vignettes/*.pdf # knitr and R markdown default cache directories /*_cache/ /cache/ +*_cache/ # Temporary files created by R markdown *.utf8.md *.knit.md .Rproj.user + +# Mac OS X File +.DS_Store