From 283387113a1554bcfed2c60f3a83b0af1728c46c Mon Sep 17 00:00:00 2001 From: Christiane Gross Date: Tue, 14 Nov 2023 11:16:02 +0100 Subject: [PATCH 1/3] UWerr: We can also specify a main when plotting an UWerr-result with pl=TRUE --- R/UWerr.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/UWerr.R b/R/UWerr.R index 758c97a30..72ee9df60 100644 --- a/R/UWerr.R +++ b/R/UWerr.R @@ -20,6 +20,7 @@ #' @param pl logical: if TRUE, the autocorrelation function, the integrated #' autocorrelation time as function of the integration cut-off and (for primary #' quantities) the time history of the observable are plotted with plot.uwerr +#' @param main character, title of the plots #' @param ... arguments passed to function \code{f}. #' @return In case of a primary observable (\code{uwerrprimary}), an object of #' class \code{uwerr} with basis class \code{\link{list}} containing the @@ -60,7 +61,7 @@ #' plot(plaq.res) #' #' @export uwerr -uwerr <- function(f, data, nrep, S=1.5, pl=FALSE, ...) { +uwerr <- function(f, data, nrep, S=1.5, pl=FALSE, main="", ...) { # f: scalar function handle, needed for derived quantities # data: the matrix of data with dim. (Nalpha x N) # N = total number of measurements @@ -71,18 +72,18 @@ uwerr <- function(f, data, nrep, S=1.5, pl=FALSE, ...) { if(missing(nrep)) { nrep <- c(length(data)) } - return(invisible(uwerrprimary(data=data, nrep=nrep, S=S, pl=pl))) + return(invisible(uwerrprimary(data=data, nrep=nrep, S=S, pl=pl, main=main))) } else { if(missing(nrep)) { nrep <- c(length(data[1,])) } - return(invisible(uwerrderived(f=f, data=data, nrep=nrep, S=S, pl=pl, ...))) + return(invisible(uwerrderived(f=f, data=data, nrep=nrep, S=S, pl=pl, main=main, ...))) } } #' @export -uwerrprimary <- function(data, nrep, S=1.5, pl=FALSE) { +uwerrprimary <- function(data, nrep, S=1.5, pl=FALSE, main="") { N = length(data) if(missing(nrep)) { @@ -202,14 +203,14 @@ uwerrprimary <- function(data, nrep, S=1.5, pl=FALSE) { attr(res, "class") <- c("uwerr", "list") if(pl) { - plot(res) + plot(res, main=main) } return(invisible(res)) } #' @export -uwerrderived <- function(f, data, nrep, S=1.5, pl=FALSE, ...) { +uwerrderived <- function(f, data, nrep, S=1.5, pl=FALSE, main="", ...) { Nalpha <- dim(data)[2] N <- dim(data)[1] if(missing(nrep)) { @@ -392,7 +393,7 @@ uwerrderived <- function(f, data, nrep, S=1.5, pl=FALSE, ...) { attr(res, "class") <- c("uwerr", "list") if(pl) { - plot(res) + plot(res, main=main) } options(error = NULL) From 8608c339a5bba2e5c9f62672c9bff8806f904ef0 Mon Sep 17 00:00:00 2001 From: Christiane Gross Date: Tue, 14 Nov 2023 11:19:18 +0100 Subject: [PATCH 2/3] cf: when we call uwerr.cf, we can also specify the parameter S now --- R/cf.R | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/R/cf.R b/R/cf.R index fd496e4ec..29ba0c673 100644 --- a/R/cf.R +++ b/R/cf.R @@ -673,6 +673,8 @@ jackknife.cf <- function(cf, boot.l = 1) { #' Gamma method analysis on all time-slices in a 'cf' object #' #' @param cf Object of type `cf` containing `cf_orig` +#' @param S initial guess for the ratio tau/tauint, with tau the exponetial +#' autocorrelation length. #' #' @return A list with a named element `uwcf` which contains a data frame #' with six columns, `value`, `dvalue`, `ddvalue`, `tauint`, `dtauint` @@ -690,11 +692,11 @@ jackknife.cf <- function(cf, boot.l = 1) { #' uwerr.cf(samplecf) #' #' @export -uwerr.cf <- function(cf){ +uwerr.cf <- function(cf, S=1.5){ stopifnot(inherits(cf, 'cf_orig')) - uw_wrapper <- function(x){ - uw_tmp <- try(uwerrprimary(data=x), silent=TRUE) + uw_wrapper <- function(x, S){ + uw_tmp <- try(uwerrprimary(data=x, S=S), silent=TRUE) if( any(class(uw_tmp) == "try-error") ){ c(value=NA, dvalue=NA, ddvalue=NA, tauint=NA, dtauint=NA) } else { @@ -704,10 +706,10 @@ uwerr.cf <- function(cf){ } res <- list() - res[["uwcf"]] <- cbind(as.data.frame(t(apply(X=cf$cf, MARGIN=2L, FUN=uw_wrapper))), + res[["uwcf"]] <- cbind(as.data.frame(t(apply(X=cf$cf, MARGIN=2L, FUN=uw_wrapper, S=S))), t=(1:ncol(cf$cf))) if( has_icf(cf) ){ - res[["uwicf"]] <- cbind(as.data.frame(t(apply(X=cf$icf, MARGIN=2L, FUN=uw_wrapper))), + res[["uwicf"]] <- cbind(as.data.frame(t(apply(X=cf$icf, MARGIN=2L, FUN=uw_wrapper, S=S))), t=(1:ncol(cf$icf))) } return(res) @@ -715,6 +717,7 @@ uwerr.cf <- function(cf){ + #' add a configuration index to an \code{cf} object #' #' add a configuration number index to \code{cf} object. From dec9d57dd31866b58bb26f1ad74e54a699dc81c1 Mon Sep 17 00:00:00 2001 From: Christiane Gross Date: Tue, 14 Nov 2023 11:22:11 +0100 Subject: [PATCH 3/3] cf: when calling uwerr on cf, we can now also plot the results --- R/cf.R | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/R/cf.R b/R/cf.R index 29ba0c673..5ee0c8880 100644 --- a/R/cf.R +++ b/R/cf.R @@ -675,6 +675,10 @@ jackknife.cf <- function(cf, boot.l = 1) { #' @param cf Object of type `cf` containing `cf_orig` #' @param S initial guess for the ratio tau/tauint, with tau the exponetial #' autocorrelation length. +#' @param pl logical: if TRUE, the autocorrelation function, the integrated +#' autocorrelation time as function of the integration cut-off and (for primary +#' quantities) the time history of the observable are plotted with plot.uwerr +#' @param main character, title of the plots #' #' @return A list with a named element `uwcf` which contains a data frame #' with six columns, `value`, `dvalue`, `ddvalue`, `tauint`, `dtauint` @@ -692,24 +696,24 @@ jackknife.cf <- function(cf, boot.l = 1) { #' uwerr.cf(samplecf) #' #' @export -uwerr.cf <- function(cf, S=1.5){ +uwerr.cf <- function(cf, S=1.5, pl=FALSE, main=""){ stopifnot(inherits(cf, 'cf_orig')) - uw_wrapper <- function(x, S){ - uw_tmp <- try(uwerrprimary(data=x, S=S), silent=TRUE) + uw_wrapper <- function(x, S, pl, main){ + uw_tmp <- try(uwerrprimary(data=x, S=S, pl=pl, main=main), silent=TRUE) if( any(class(uw_tmp) == "try-error") ){ - c(value=NA, dvalue=NA, ddvalue=NA, tauint=NA, dtauint=NA) + c(value=NA, dvalue=NA, ddvalue=NA, tauint=NA, dtauint=NA, S=S) } else { c(value=uw_tmp$value, dvalue=uw_tmp$dvalue, ddvalue=uw_tmp$ddvalue, - tauint=uw_tmp$tauint, dtauint=uw_tmp$dtauint) + tauint=uw_tmp$tauint, dtauint=uw_tmp$dtauint, S=S) } } res <- list() - res[["uwcf"]] <- cbind(as.data.frame(t(apply(X=cf$cf, MARGIN=2L, FUN=uw_wrapper, S=S))), + res[["uwcf"]] <- cbind(as.data.frame(t(apply(X=cf$cf, MARGIN=2L, FUN=uw_wrapper, S=S, pl=pl, main=main))), t=(1:ncol(cf$cf))) if( has_icf(cf) ){ - res[["uwicf"]] <- cbind(as.data.frame(t(apply(X=cf$icf, MARGIN=2L, FUN=uw_wrapper, S=S))), + res[["uwicf"]] <- cbind(as.data.frame(t(apply(X=cf$icf, MARGIN=2L, FUN=uw_wrapper, S=S, pl=pl, main=main))), t=(1:ncol(cf$icf))) } return(res)