diff --git a/.Rbuildignore b/.Rbuildignore index ae9b72e..6c364e7 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -4,3 +4,5 @@ ^README\.Rmd$ ^data-raw$ ^\.github$ +^notes\.Rmd$ +^playground\.Rmd$ diff --git a/.Rproj.user/429CC01A/pcs/source-pane.pper b/.Rproj.user/429CC01A/pcs/source-pane.pper index ea660b4..aa8cf68 100644 --- a/.Rproj.user/429CC01A/pcs/source-pane.pper +++ b/.Rproj.user/429CC01A/pcs/source-pane.pper @@ -1,3 +1,3 @@ { - "activeTab": 6 + "activeTab": 7 } \ No newline at end of file diff --git a/.Rproj.user/429CC01A/pcs/windowlayoutstate.pper b/.Rproj.user/429CC01A/pcs/windowlayoutstate.pper index 3574f13..72ca410 100644 --- a/.Rproj.user/429CC01A/pcs/windowlayoutstate.pper +++ b/.Rproj.user/429CC01A/pcs/windowlayoutstate.pper @@ -1,14 +1,14 @@ { "left": { - "splitterpos": 275, + "splitterpos": 352, "topwindowstate": "NORMAL", - "panelheight": 937, - "windowheight": 975 + "panelheight": 939, + "windowheight": 977 }, "right": { - "splitterpos": 348, + "splitterpos": 347, "topwindowstate": "NORMAL", - "panelheight": 937, - "windowheight": 975 + "panelheight": 939, + "windowheight": 977 } } \ No newline at end of file diff --git a/.Rproj.user/429CC01A/pcs/workbench-pane.pper b/.Rproj.user/429CC01A/pcs/workbench-pane.pper index 75e70e9..c38a0b3 100644 --- a/.Rproj.user/429CC01A/pcs/workbench-pane.pper +++ b/.Rproj.user/429CC01A/pcs/workbench-pane.pper @@ -1,5 +1,5 @@ { - "TabSet1": 0, + "TabSet1": 4, "TabSet2": 0, "TabZoom": {} } \ No newline at end of file diff --git a/.gitignore b/.gitignore index 377c805..ed93337 100644 --- a/.gitignore +++ b/.gitignore @@ -1,30 +1,23 @@ # History files .Rhistory .Rapp.history - # Session Data files .RData .RDataTmp - # User-specific files .Ruserdata - # Example code in package build process *-Ex.R - # Output files from R CMD build /*.tar.gz - # Output files from R CMD check /*.Rcheck/ - # RStudio files .Rproj.user/ - # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 .httr-oauth - .Rdata .DS_Store README.Rmd playground.Rmd +notes.Rmd diff --git a/R/get_header.R b/R/get_header.R index 15d83b1..54d1f3d 100644 --- a/R/get_header.R +++ b/R/get_header.R @@ -1,14 +1,14 @@ -#' get_header: retrieves the attributes of a .fh/Heidelberg format file +#' get_header: retrieve the HEADER fields of a Heidelberg format (.fh) file #' -#' @description This function reports the HEADER fields from a .fh/Heidelberg -#' format file. The header fields are harvested from the .fh file by the -#' `read_fh()` function, which stores the HEADER fields in the .fh file as -#' attributes of the `data.frame` it returns. +#' @description This function reports the HEADER fields from a Heidelberg +#' format (.fh) ring-width file. The header fields are harvested from the +#' .fh-file by the `read_fh()` function, which stores the HEADER fields from +#' the .fh file as attributes of the `data.frame` it returns. #' #' @param rwl The output of `read_fh(x, header = TRUE)`, #' a `data.frame` of class `rwl`. #' -#' @return A `data.frame` with 26 header fields. +#' @return A `data.frame` with 29 header fields. #' #' @export diff --git a/R/read_fh.R b/R/read_fh.R index 43485c7..4b6712c 100644 --- a/R/read_fh.R +++ b/R/read_fh.R @@ -1,8 +1,8 @@ -#' read_fh: read a .fh/Heidelberg format file +#' read_fh: read a Heidelberg format (.fh) tree-ring file #' #' @description -#' This function reads in a .fh/Heidelberg format file of ring widths AND lists -#' HEADER fields as attributes. +#' This function reads in a Heidelberg format file (.fh) of ring widths and +#' returns HEADER fields as attributes. #' #' @param fname A `character` vector giving the name of the file name of #' the fh file. @@ -12,23 +12,32 @@ #' @param header A `logical`. if `TRUE` the HEADER fields are returned as #' a `data.frame`, if `FALSE` the measurement data are returned. #' -#' @references This function is an extension of the `read.fh()` function from -#' the **dplR package**, developped by Andy Bunn (Bunn 2008, Bunn 2010, -#' Bunn et al. 2022). +#' @references This function is an extension of `read.fh()` from +#' the **dplR package** (), developed and +#' maintained by Prof. dr. Andy Bunn (Bunn 2008, Bunn 2010, Bunn et al. 2022) +#' on . #' #' @details This reads in a fh-file with ring widths in blocks (decadal format) -#' or in columns (e.g., as with comment flags) as used by TSAP program. -#' Chronologies or half-chronos in fh-format are ALSO supported. The +#' or in columns (e.g., with comment flags) as used by TSAP program. +#' Chronologies or half-chronos in block format are also supported. The #' `read_fh()` function is case insensitive. Information found in the HEADER #' fields are listed as attributes. #' -#' @return a `data.frame` containing ring-width measurements with calendar +#' The header fields harvested from the .fh file include: +#' +#' "Project" "FirstMeasurementDate" "Location" "Town" "Street" "Client" +#' "Longitude" "Latitude" "DateOfSampling" "FirstMeasurementDate" "SapWoodRings" +#' "Comment" "MissingRingsAfter" "InvalidRingsAfter" "MissingringsBefore" +#' "DeltaMissingringsBefgore" "ChronoMemberKeycodes" "PersId" +#' +#' @return A `data.frame` with ring-width measurements in columns, (calendar) #' years as `row.names` and header fields as `attributes.` #' #' @author The original `read.fh()` function is part of the **dplR package** -#' and was developped by Christian Zang, with new features and patches by Mikko -#' Korpela and Ronald Visser. This `read_fh()` function expands the -#' functionalities of the original [dplR::read.fh()] function. +#' () and was developped by Christian Zang, +#' with new features and patches by Mikko Korpela and Ronald Visser. +#' This `read_fh()` function expands the functionalities of the original +#' [dplR::read.fh()]. #' #' @export @@ -39,7 +48,7 @@ read_fh <- function( header = FALSE) { # NEW: verbose = TRUE, header = FALSE inp <- readLines(fname, ok=TRUE, warn=FALSE) - # removes empty lines in .fh file + # NEW: removes empty lines in .fh file inp <- inp[nchar(inp)!=0] ## Get start and end positions of headers and data blocks header.begin <- grep("^HEADER:$", inp) @@ -94,13 +103,14 @@ read_fh <- function( radius.vec <- rep(NA_real_, n) stemdisk.vec <- rep(NA_real_, n) pith.offset <- rep(NA_real_, n) - ## NEW: data_type added - data_type <- character(n) ## NEW: extra header fields added + pith_offset_delta <- rep(NA_real_, n) + data_type <- character(n) species <- rep(NA_character_, n) sapwoodrings <- numeric(n) - sapwoodrings_note <- rep(NA_character_, n) - unmeasuredRings <- numeric(n) + sapwoodrings_chr <- rep(NA_character_, n) + unmeasured_rings <- numeric(n) + invalid_rings <- numeric(n) status <- rep(NA_character_, n) waneyedge <- rep(NA_character_, n) bark <- rep(NA_character_, n) @@ -113,6 +123,7 @@ read_fh <- function( street <- rep(NA_character_, n) personal_id <- rep(NA_character_, n) sampling_date <- rep(NA_character_, n) + measuring_date <- rep(NA_character_, n) client_id <- rep(NA_character_, n) longitude <- rep(NA_character_, n) latitude <- rep(NA_character_, n) @@ -270,7 +281,17 @@ read_fh <- function( pith.offset[i] <- tmp + 1 } } - ## TODO: When Header field 'DeltaMissingRingsBefore' has a value, length(this.missing) > 1 + ## NEW: get pith offset uncertainty (delta missing rings before start of series) + this.missing.delta <- + sub("DELTAMISSINGRINGSBEFORE=", "", ignore.case = TRUE, + x=grep("^DELTAMISSINGRINGSBEFORE=", this.header, value=TRUE, + ignore.case = TRUE)) + if (length(this.missing.delta) == 1) { + tmp <- suppressWarnings(as.numeric(this.missing.delta)) + if (identical(tmp, round(tmp)) && tmp >= 0 && !is.na(tmp)) { #new !is.na() when text input + pith_offset_delta[i] <- tmp + } + } ## NEW: get Species code this.species <- sub("SPECIES=", "", ignore.case=TRUE, @@ -314,7 +335,7 @@ read_fh <- function( if (length(this.swr) == 1){ if (is.na(suppressWarnings(as.numeric(this.swr)))) { tmp <- suppressWarnings(as.character(this.swr)) - sapwoodrings_note[i] <- tmp + sapwoodrings_chr[i] <- tmp } } @@ -346,27 +367,33 @@ read_fh <- function( this.missing <- sub("MISSINGRINGSAFTER=", "", ignore.case = TRUE, x = grep("^MISSINGRINGSAFTER=", this.header, value = TRUE,ignore.case = TRUE)) + ### when no missing rings are present NA instead of zero if (identical(this.missing, character(0))) { - unmeasuredRings[i] <- NA + unmeasured_rings[i] <- NA } if (length(this.missing) == 1) { tmp <- suppressWarnings(as.numeric(this.missing)) if (identical(tmp, round(tmp))) { - unmeasuredRings[i] <- tmp + unmeasured_rings[i] <- tmp } } - ## NEW: get unmeasured, but observed rings (InvalidRingsAfter) - ### usually instead of MissingRingsAfter - this.missing <- sub("INVALIDRINGSAFTER=", "", ignore.case = TRUE, + ## NEW: get unreliable measurements at end - e.g. deformed rings (InvalidRingsAfter) + ### sometimes this field is used instead of MissingRingsAfter + this.invalid <- sub("INVALIDRINGSAFTER=", "", ignore.case = TRUE, x = grep("^INVALIDRINGSAFTER=", this.header, value = TRUE, ignore.case = TRUE)) - if (length(this.missing) == 1) { - tmp <- suppressWarnings(as.numeric(this.missing)) - if (identical(tmp, round(tmp)) && tmp > 0) { - unmeasuredRings[i] <- tmp - } + + ### when no invalid rings are present NA instead of zero + if (identical(this.invalid, character(0))) { + invalid_rings[i] <- NA + } + if (length(this.invalid) == 1) { + tmp <- suppressWarnings(as.numeric(this.invalid)) + if (identical(tmp, round(tmp))) { + invalid_rings[i] <- tmp + } } ## NEW: get project name @@ -417,11 +444,19 @@ read_fh <- function( } ## NEW: get sampling date - this.date <- sub("DATEOFSAMPLING=", "", ignore.case=TRUE, + this.date.sampling <- sub("DATEOFSAMPLING=", "", ignore.case=TRUE, x = grep("^DATEOFSAMPLING=", this.header, value = TRUE, ignore.case = TRUE)) - if (length(this.date) == 1) { - sampling_date[i] <- this.date + if (length(this.date.sampling) == 1) { + sampling_date[i] <- this.date.sampling + } + + ## NEW: get first measurement date + this.date.measuring <- sub("FIRSTMEASUREMENTDATE=", "", ignore.case=TRUE, + x = grep("^FIRSTMEASUREMENTDATE=", this.header, value = TRUE, + ignore.case = TRUE)) + if (length(this.date.measuring) == 1) { + measuring_date[i] <- this.date.measuring } ## NEW: get client id @@ -592,7 +627,7 @@ read_fh <- function( "There is %d series\n", "There are %d series\n", domain="R-dplR"), n - ) + ) ) start.years.char <- format(start.years, scientific=FALSE, trim=TRUE) end.years.char <- format(end.years, scientific=FALSE, trim=TRUE) @@ -700,14 +735,16 @@ read_fh <- function( attr(rwl, "first") <- start.years attr(rwl, "last") <- end.years attr(rwl, "length") <- lengths - attr(rwl, "swr") <- sapwoodrings - attr(rwl, "swr_note") <- sapwoodrings_note - attr(rwl, "unmeasuredRings") <- unmeasuredRings + attr(rwl, "n_sapwood") <- sapwoodrings + attr(rwl, "n_sapwood_chr") <- sapwoodrings_chr + attr(rwl, "unmeasured_rings") <- unmeasured_rings + attr(rwl, "invalid_rings") <- invalid_rings attr(rwl, "status") <- status attr(rwl, "waneyedge") <- waneyedge attr(rwl, "bark") <- bark attr(rwl, "pith") <- pith attr(rwl, "pith_offset") <- pith.offset + attr(rwl, "pith_offset_delta") <- pith_offset_delta attr(rwl, "comments") <- comments attr(rwl, "project") <- project attr(rwl, "location") <- location @@ -715,6 +752,7 @@ read_fh <- function( attr(rwl, "zip") <- town_zip attr(rwl, "street") <- street attr(rwl, "sampling_date") <- sampling_date + attr(rwl, "measuring_date") <- measuring_date attr(rwl, "personal_id") <- personal_id attr(rwl, "client_id") <- client_id attr(rwl, "longitude") <- longitude diff --git a/man/get_header.Rd b/man/get_header.Rd index ee5b992..d6dfd3b 100644 --- a/man/get_header.Rd +++ b/man/get_header.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_header.R \name{get_header} \alias{get_header} -\title{get_header: retrieves the attributes of a .fh/Heidelberg format file} +\title{get_header: retrieve the HEADER fields of a Heidelberg format (.fh) file} \usage{ get_header(rwl) } @@ -11,11 +11,11 @@ get_header(rwl) a \code{data.frame} of class \code{rwl}.} } \value{ -A \code{data.frame} with 26 header fields. +A \code{data.frame} with 29 header fields. } \description{ -This function reports the HEADER fields from a .fh/Heidelberg -format file. The header fields are harvested from the .fh file by the -\code{read_fh()} function, which stores the HEADER fields in the .fh file as -attributes of the \code{data.frame} it returns. +This function reports the HEADER fields from a Heidelberg +format (.fh) ring-width file. The header fields are harvested from the +.fh-file by the \code{read_fh()} function, which stores the HEADER fields from +the .fh file as attributes of the \code{data.frame} it returns. } diff --git a/man/read_fh.Rd b/man/read_fh.Rd index 8ea8bb0..e2dc8c3 100644 --- a/man/read_fh.Rd +++ b/man/read_fh.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/read_fh.R \name{read_fh} \alias{read_fh} -\title{read_fh: read a .fh/Heidelberg format file} +\title{read_fh: read a Heidelberg format (.fh) tree-ring file} \usage{ read_fh(fname, BC_correction = FALSE, verbose = TRUE, header = FALSE) } @@ -19,28 +19,37 @@ one year forward.} a \code{data.frame}, if \code{FALSE} the measurement data are returned.} } \value{ -a \code{data.frame} containing ring-width measurements with calendar +A \code{data.frame} with ring-width measurements in columns, (calendar) years as \code{row.names} and header fields as \code{attributes.} } \description{ -This function reads in a .fh/Heidelberg format file of ring widths AND lists -HEADER fields as attributes. +This function reads in a Heidelberg format file (.fh) of ring widths and +returns HEADER fields as attributes. } \details{ This reads in a fh-file with ring widths in blocks (decadal format) -or in columns (e.g., as with comment flags) as used by TSAP program. -Chronologies or half-chronos in fh-format are ALSO supported. The +or in columns (e.g., with comment flags) as used by TSAP program. +Chronologies or half-chronos in block format are also supported. The \code{read_fh()} function is case insensitive. Information found in the HEADER fields are listed as attributes. + +The header fields harvested from the .fh file include: + +"Project" "FirstMeasurementDate" "Location" "Town" "Street" "Client" +"Longitude" "Latitude" "DateOfSampling" "FirstMeasurementDate" "SapWoodRings" +"Comment" "MissingRingsAfter" "InvalidRingsAfter" "MissingringsBefore" +"DeltaMissingringsBefgore" "ChronoMemberKeycodes" "PersId" } \references{ -This function is an extension of the \code{read.fh()} function from -the \strong{dplR package}, developped by Andy Bunn (Bunn 2008, Bunn 2010, -Bunn et al. 2022). +This function is an extension of \code{read.fh()} from +the \strong{dplR package} (\url{https://github.com/opendendro/dplR}), developed and +maintained by Prof. dr. Andy Bunn (Bunn 2008, Bunn 2010, Bunn et al. 2022) +on \url{https://opendendro.org/}. } \author{ The original \code{read.fh()} function is part of the \strong{dplR package} -and was developped by Christian Zang, with new features and patches by Mikko -Korpela and Ronald Visser. This \code{read_fh()} function expands the -functionalities of the original \code{\link[dplR:read.fh]{dplR::read.fh()}} function. +(\url{https://github.com/opendendro/dplR}) and was developped by Christian Zang, +with new features and patches by Mikko Korpela and Ronald Visser. +This \code{read_fh()} function expands the functionalities of the original +\code{\link[dplR:read.fh]{dplR::read.fh()}}. }