From 6a471075cd4a53ff3c58db42df4a5871fb0037a9 Mon Sep 17 00:00:00 2001 From: ArthurBailly Date: Mon, 21 Oct 2024 11:56:14 +0200 Subject: [PATCH] - Added element_blank as an import from ggplot2 - Improved modelHD documentation - Update NAMESPACE --- NAMESPACE | 7 +++++ R/checkPlotCoord.R | 4 +-- R/cutPlot.R | 2 +- R/modelHD.R | 26 +++++++++------ man/cutPlot.Rd | 2 +- man/modelHD.Rd | 40 ++++++++++++++---------- tests/testthat/test_00_modelHD.R | 14 ++++----- tests/testthat/test_01_correctCoordGPS.R | 12 +++---- 8 files changed, 63 insertions(+), 44 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index bd6aa13..dd36c22 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,16 +42,23 @@ importFrom(data.table,tstrsplit) importFrom(ggplot2,aes) importFrom(ggplot2,arrow) importFrom(ggplot2,coord_equal) +importFrom(ggplot2,element_blank) +importFrom(ggplot2,element_text) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_polygon) importFrom(ggplot2,geom_segment) +importFrom(ggplot2,geom_smooth) importFrom(ggplot2,geom_text) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggtitle) +importFrom(ggplot2,labs) importFrom(ggplot2,scale_color_manual) importFrom(ggplot2,scale_shape_manual) +importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme) importFrom(ggplot2,theme_minimal) +importFrom(ggplot2,unit) importFrom(grDevices,terrain.colors) importFrom(graphics,axis) importFrom(graphics,grid) diff --git a/R/checkPlotCoord.R b/R/checkPlotCoord.R index 2a02190..7d1394d 100644 --- a/R/checkPlotCoord.R +++ b/R/checkPlotCoord.R @@ -34,7 +34,7 @@ #' #' @importFrom data.table data.table := setnames #' @importFrom sf st_multipoint st_polygon st_sfc -#' @importFrom ggplot2 ggplot aes geom_point geom_segment geom_polygon geom_text scale_shape_manual scale_color_manual ggtitle theme_minimal theme coord_equal arrow unit +#' @importFrom ggplot2 ggplot aes geom_point geom_segment geom_polygon geom_text scale_shape_manual scale_color_manual ggtitle theme_minimal theme coord_equal arrow unit element_blank #' #' @author Arthur PERE, Maxime REJOU-MECHAIN, Arthur BAILLY #' @@ -78,7 +78,7 @@ #' checkPlotCoord <- function(projCoord = NULL, longlat = NULL, relCoord, trustGPScorners, cornerID=NULL, maxDist = 15, rmOutliers = TRUE, drawPlot = TRUE, treeCoord = NULL) { - # parameters verification ------------------------------------------------- + # Checking arguments ------------------------------------------------- if (is.null(longlat) && is.null(projCoord)) { stop("Give at least one set of coordinates: longlat or projCoord") diff --git a/R/cutPlot.R b/R/cutPlot.R index c082f5d..73476d2 100644 --- a/R/cutPlot.R +++ b/R/cutPlot.R @@ -4,7 +4,7 @@ if (getRversion() >= "2.15.1") { )) } -#' Divides a plot in subplots +#' Divides one ore more plots into subplots #' #' This function divides a plot (or several plots) in subplots and returns the coordinates of the grid. #' This function uses a procrust analysis to fit the rectangle you gave to the plot you have. diff --git a/R/modelHD.R b/R/modelHD.R index 58c365c..21a00e4 100644 --- a/R/modelHD.R +++ b/R/modelHD.R @@ -44,7 +44,6 @@ #' If the parameter model is null, the function return a plot with all the methods for #' comparison, the function also returns a data.frame with: #' - `method`: The method that had been used to construct the plot -#' - `color`: The color of the curve in the plot #' - `RSE`: Residual Standard Error of the model #' - `RSElog`: Residual Standard Error of the log model (`NULL` if other model) #' - `Average_bias`: The average bias for the model @@ -61,29 +60,36 @@ #' # Load a data set #' data(NouraguesHD) #' -#' # To model the height from a dataset +#' # Fit H-D models for the Nouragues dataset #' \donttest{ #' HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, drawGraph = TRUE) #' } #' -#' # If the method needed is known -#' HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, method = "weibull", drawGraph = TRUE) -#' HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, method = "log1", drawGraph = TRUE) +#' # For a chosen model +#' HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, +#' method = "log2", drawGraph = TRUE) #' #' # Using weights #' HDmodel <- modelHD( -#' D = NouraguesHD$D, H = NouraguesHD$H, method = "weibull", useWeight = TRUE, -#' drawGraph = TRUE -#' ) +#' D = NouraguesHD$D, H = NouraguesHD$H, +#' method = "log2", useWeight = TRUE, +#' drawGraph = TRUE) +#' +#' # With multiple stands (plots) +#' HDmodel <- modelHD( +#' D = NouraguesHD$D, H = NouraguesHD$H, +#' method = "log2", useWeight = TRUE, +#' plot = NouraguesHD$plotId, drawGraph = TRUE) +#' #' @importFrom graphics legend lines par plot grid axis #' @importFrom stats SSmicmen lm median na.omit quantile rnorm sd predict coef #' @importFrom utils data #' @importFrom data.table data.table -#' @importFrom ggplot2 ggplot aes geom_point geom_smooth labs theme_minimal theme scale_x_continuous scale_y_continuous +#' @importFrom ggplot2 ggplot aes geom_point geom_smooth labs theme_minimal theme scale_x_continuous scale_y_continuous element_text modelHD <- function(D, H, method = NULL, useWeight = FALSE, drawGraph = FALSE, plot = NULL) { - # parameters verification ------------------------------------------------- + # Checking arguments ------------------------------------------------- # Check if there is enough data to compute an accurate model nbNonNA <- sum(!is.na(H)) diff --git a/man/cutPlot.Rd b/man/cutPlot.Rd index c6e6f8b..e514478 100644 --- a/man/cutPlot.Rd +++ b/man/cutPlot.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/cutPlot.R \name{cutPlot} \alias{cutPlot} -\title{Divides one ore more plots in subplots} +\title{Divides one ore more plots into subplots} \usage{ cutPlot(projCoord, plot, cornerNum, gridsize = 100, dimX = 200, dimY = 200) } diff --git a/man/modelHD.Rd b/man/modelHD.Rd index 46a59d7..d90fbac 100644 --- a/man/modelHD.Rd +++ b/man/modelHD.Rd @@ -7,11 +7,9 @@ modelHD(D, H, method = NULL, useWeight = FALSE, drawGraph = FALSE, plot = NULL) } \arguments{ -\item{D}{Vector with diameter measurements (in cm). NA values are accepted but a -minimum of 10 valid entries (i.e. having a corresponding height in H) is required.} +\item{D}{Vector with diameter measurements (in cm). NA values are accepted but a minimum of 10 valid entries (i.e. having a corresponding height in H) is required.} -\item{H}{Vector with total height measurements (in m). NA values are accepted but a minimum of 10 valid entries -(i.e. having a corresponding diameter in D) is required.} +\item{H}{Vector with total height measurements (in m). NA values are accepted but a minimum of 10 valid entries (i.e. having a corresponding diameter in D) is required.} \item{method}{Method used to fit the relationship. To be chosen between: @@ -36,9 +34,10 @@ volume, so that larger trees have a stronger influence during the construction o stand-specific HD models.} } \value{ -If plot is NULL or has a single value, a single list is returned. If there is more than one plot, +If \code{plot} is NULL or has a single value, a single list is returned. If there is more than one plot, multiple embedded lists are returned with plots as the list names. -Returns a list if the parameter model is not null: + +If \code{model} is not null (model comparison), returns a list : \itemize{ \item \code{input}: list of the data used to construct the model (list(H, D)) \item \code{model}: outputs of the model (same outputs as given by \code{\link[stats:lm]{stats::lm()}}, \code{\link[stats:nls]{stats::nls()}}) @@ -50,13 +49,13 @@ Returns a list if the parameter model is not null: \item \code{formula}: Formula of the model \item \code{method}: Name of the method used to construct the model \item \code{predicted}: Predicted height values +\item \code{fitPlot}: a ggplot object containing the model fitting plot } -If the parameter model is null, the function return a graph with all the methods for +If the parameter model is null, the function return a plot with all the methods for comparison, the function also returns a data.frame with: \itemize{ -\item \code{method}: The method that had been used to construct the graph -\item \code{color}: The color of the curve in the graph +\item \code{method}: The method that had been used to construct the plot \item \code{RSE}: Residual Standard Error of the model \item \code{RSElog}: Residual Standard Error of the log model (\code{NULL} if other model) \item \code{Average_bias}: The average bias for the model @@ -74,24 +73,31 @@ where RSE is the Residual Standard Error). # Load a data set data(NouraguesHD) -# To model the height from a dataset +# Fit H-D models for the Nouragues dataset \donttest{ HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, drawGraph = TRUE) } -# If the method needed is known -HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, method = "weibull", drawGraph = TRUE) -HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, method = "log1", drawGraph = TRUE) +# For a chosen model +HDmodel <- modelHD(D = NouraguesHD$D, H = NouraguesHD$H, +method = "log2", drawGraph = TRUE) # Using weights HDmodel <- modelHD( - D = NouraguesHD$D, H = NouraguesHD$H, method = "weibull", useWeight = TRUE, - drawGraph = TRUE -) + D = NouraguesHD$D, H = NouraguesHD$H, + method = "log2", useWeight = TRUE, + drawGraph = TRUE) + +# With multiple stands (plots) +HDmodel <- modelHD( + D = NouraguesHD$D, H = NouraguesHD$H, + method = "log2", useWeight = TRUE, + plot = NouraguesHD$plotId, drawGraph = TRUE) + } \seealso{ \code{\link[=retrieveH]{retrieveH()}} } \author{ -Maxime REJOU-MECHAIN, Arthur PERE, Ariane TANGUY +Maxime REJOU-MECHAIN, Arthur PERE, Ariane TANGUY, Arthur Bailly } diff --git a/tests/testthat/test_00_modelHD.R b/tests/testthat/test_00_modelHD.R index 9ac0872..dd2d5e1 100644 --- a/tests/testthat/test_00_modelHD.R +++ b/tests/testthat/test_00_modelHD.R @@ -1,4 +1,4 @@ -require(data.table) +#require(data.table) D <- NouraguesHD$D H <- NouraguesHD$H @@ -58,13 +58,13 @@ test_that("Without parameters", { Res <- expect_message(modelHD(D, H, useWeight = TRUE), "build a HD model") expect_is(Res, "data.frame") - expect_equal(ncol(Res), 5) + expect_equal(ncol(Res),4) - res <- "method color RSE RSElog Average_bias -log1 blue 4.305060 0.2231136 0.004227454 -log2 green 4.222718 0.2215495 0.003121671 -weibull orange 4.307951 NA 0.002823978 -michaelis purple 4.294488 NA 0.014564152 + res <- "method RSE RSElog Average_bias +log1 4.305060 0.2231136 0.004227454 +log2 4.222718 0.2215495 0.003121671 +weibull 4.307951 NA 0.002823978 +michaelis 4.294488 NA 0.014564152 " diff --git a/tests/testthat/test_01_correctCoordGPS.R b/tests/testthat/test_01_correctCoordGPS.R index 3971462..e10cb97 100644 --- a/tests/testthat/test_01_correctCoordGPS.R +++ b/tests/testthat/test_01_correctCoordGPS.R @@ -71,26 +71,26 @@ test_that("correct coord GPS in UTM", { }) test_that("correct coord GPS error", { - expect_error(correctCoordGPS(), "Give at least one set of coordinates") + expect_error(suppressWarnings(correctCoordGPS()), "Give at least one set of coordinates") expect_error( - correctCoordGPS(projCoord = projCoord, coordRel = coordRel, rangeX = 52, rangeY = 53,rmOutliers = FALSE), + suppressWarnings(correctCoordGPS(projCoord = projCoord, coordRel = coordRel, rangeX = 52, rangeY = 53,rmOutliers = FALSE)), "must be of length 2" ) expect_error( - correctCoordGPS(projCoord = projCoord, coordRel = coordRel, rangeX = c(0, 100), rangeY = c(0, 100), maxDist = c(15, 0),rmOutliers = FALSE), + suppressWarnings(correctCoordGPS(projCoord = projCoord, coordRel = coordRel, rangeX = c(0, 100), rangeY = c(0, 100), maxDist = c(15, 0),rmOutliers = FALSE)), "Your argument maxDist must be of length 1" ) expect_error( - correctCoordGPS(projCoord = projCoord, coordRel = coordRel, rangeX = c(0, 40), rangeY = c(0, 40),rmOutliers = FALSE), + suppressWarnings(correctCoordGPS(projCoord = projCoord, coordRel = coordRel, rangeX = c(0, 40), rangeY = c(0, 40),rmOutliers = FALSE)), "coordRel must be inside the X and Y ranges" ) expect_error( - correctCoordGPS(projCoord = projCoord, coordRel = rbind(coordRel, c(40, 40)), rangeX = c(0, 100), rangeY = c(0, 100),rmOutliers = FALSE), + suppressWarnings(correctCoordGPS(projCoord = projCoord, coordRel = rbind(coordRel, c(40, 40)), rangeX = c(0, 100), rangeY = c(0, 100),rmOutliers = FALSE)), "same dimension" ) skip_if_not_installed("proj4") expect_error( - correctCoordGPS(longlat = c(15, 12), projCoord = projCoord,rmOutliers = FALSE), + suppressWarnings(correctCoordGPS(longlat = c(15, 12), projCoord = projCoord,rmOutliers = FALSE)), "Give only one set of coordinates" ) })